{-# LANGUAGE OverloadedStrings #-}

module Bio.GB.Parser
  ( genBankP
  , rangeP
  ) where

import           Bio.GB.Type                (Feature (..), Form (..), GenBankSequence (..),
                                             Locus (..), Meta (..), Parser, Reference (..),
                                             Source (..), Version (..))
import           Bio.Sequence               (Border (..), MarkedSequence, Range (..),
                                             RangeBorder (..), markedSequence, shiftRange)
import           Control.Monad.Combinators  (many, manyTill, optional, some, (<|>))
import           Data.Char                  (isAlphaNum, isSpace, isUpper)
import           Data.Functor               (($>))
import           Data.Text                  (Text, intercalate, pack, splitOn, unpack)
import qualified Data.Text                  as T
import           Text.Megaparsec            (notFollowedBy, option, satisfy, sepBy1, takeWhile1P,
                                             takeWhileP, try, (<?>))
import           Text.Megaparsec.Char       (char, digitChar, eol, letterChar, string)
import           Text.Megaparsec.Char.Lexer (decimal)

-- | Parser of .gb file.
--
genBankP :: Parser GenBankSequence
genBankP :: Parser GenBankSequence
genBankP =  Meta -> MarkedSequence Feature Char -> GenBankSequence
GenBankSequence
        (Meta -> MarkedSequence Feature Char -> GenBankSequence)
-> ParsecT Void Text Identity Meta
-> ParsecT
     Void Text Identity (MarkedSequence Feature Char -> GenBankSequence)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity Meta
metaP ParsecT Void Text Identity Meta
-> String -> ParsecT Void Text Identity Meta
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Meta parser")
        ParsecT
  Void Text Identity (MarkedSequence Feature Char -> GenBankSequence)
-> ParsecT Void Text Identity (MarkedSequence Feature Char)
-> Parser GenBankSequence
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void Text Identity (MarkedSequence Feature Char)
gbSeqP ParsecT Void Text Identity (MarkedSequence Feature Char)
-> String
-> ParsecT Void Text Identity (MarkedSequence Feature Char)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"GB sequence parser")
        Parser GenBankSequence
-> ParsecT Void Text Identity Text -> Parser GenBankSequence
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f 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
"//" Parser GenBankSequence
-> ParsecT Void Text Identity () -> Parser GenBankSequence
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
eolSpaceP 

--------------------------------------------------------------------------------
-- Block with meta-information.
--------------------------------------------------------------------------------

metaP :: Parser Meta
metaP :: ParsecT Void Text Identity Meta
metaP = do
  Locus
locus'      <- Parser Locus
locusP Parser Locus -> String -> Parser Locus
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Locus parser"

  Maybe Text
definitionM <- ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
definitionP ParsecT Void Text Identity (Maybe Text)
-> String -> ParsecT Void Text Identity (Maybe Text)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Definition parser"
  Maybe Text
accessionM  <- ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
accessionP ParsecT Void Text Identity (Maybe Text)
-> String -> ParsecT Void Text Identity (Maybe Text)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Accession parser"
  Maybe Version
versionM    <- ParsecT Void Text Identity Version
-> ParsecT Void Text Identity (Maybe Version)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Version
versionP ParsecT Void Text Identity (Maybe Version)
-> String -> ParsecT Void Text Identity (Maybe Version)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Version parser"
  Maybe Text
keywordsM   <- ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
keywordsP ParsecT Void Text Identity (Maybe Text)
-> String -> ParsecT Void Text Identity (Maybe Text)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Keywords parser"
  Maybe Source
sourceM     <- ParsecT Void Text Identity Source
-> ParsecT Void Text Identity (Maybe Source)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Source
sourceP ParsecT Void Text Identity (Maybe Source)
-> String -> ParsecT Void Text Identity (Maybe Source)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Source parser"
  [Reference]
referencesL <- ParsecT Void Text Identity Reference
-> ParsecT Void Text Identity [Reference]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity Reference
referenceP ParsecT Void Text Identity [Reference]
-> String -> ParsecT Void Text Identity [Reference]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"References parser"
  [Text]
commentsL   <- ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity Text
commentP ParsecT Void Text Identity [Text]
-> String -> ParsecT Void Text Identity [Text]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Comments parser"

  Meta -> ParsecT Void Text Identity Meta
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Meta -> ParsecT Void Text Identity Meta)
-> Meta -> ParsecT Void Text Identity Meta
forall a b. (a -> b) -> a -> b
$ Locus
-> Maybe Text
-> Maybe Text
-> Maybe Version
-> Maybe Text
-> Maybe Source
-> [Reference]
-> [Text]
-> Meta
Meta Locus
locus' Maybe Text
definitionM Maybe Text
accessionM Maybe Version
versionM Maybe Text
keywordsM Maybe Source
sourceM [Reference]
referencesL [Text]
commentsL

locusP :: Parser Locus
locusP :: Parser Locus
locusP = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"LOCUS" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
space ParsecT Void Text Identity () -> Parser Locus -> Parser Locus
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Int -> Text -> Maybe Form -> Maybe Text -> Text -> Locus
Locus
       (Text -> Int -> Text -> Maybe Form -> Maybe Text -> Text -> Locus)
-> ParsecT Void Text Identity Text
-> ParsecT
     Void
     Text
     Identity
     (Int -> Text -> Maybe Form -> Maybe Text -> Text -> Locus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
textP ParsecT
  Void
  Text
  Identity
  (Int -> Text -> Maybe Form -> Maybe Text -> Text -> Locus)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     (Int -> Text -> Maybe Form -> Maybe Text -> Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
space                                      -- name
       ParsecT
  Void
  Text
  Identity
  (Int -> Text -> Maybe Form -> Maybe Text -> Text -> Locus)
-> ParsecT Void Text Identity Int
-> ParsecT
     Void
     Text
     Identity
     (Text -> Maybe Form -> Maybe Text -> Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal ParsecT
  Void
  Text
  Identity
  (Text -> Maybe Form -> Maybe Text -> Text -> Locus)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     (Text -> Maybe Form -> Maybe Text -> Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
space ParsecT
  Void
  Text
  Identity
  (Text -> Maybe Form -> Maybe Text -> Text -> Locus)
-> ParsecT Void Text Identity Text
-> ParsecT
     Void
     Text
     Identity
     (Text -> Maybe Form -> Maybe Text -> Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f 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
"bp" ParsecT
  Void
  Text
  Identity
  (Text -> Maybe Form -> Maybe Text -> Text -> Locus)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     (Text -> Maybe Form -> Maybe Text -> Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
space            -- sequence length
       ParsecT
  Void
  Text
  Identity
  (Text -> Maybe Form -> Maybe Text -> Text -> Locus)
-> ParsecT Void Text Identity Text
-> ParsecT
     Void Text Identity (Maybe Form -> Maybe Text -> Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
textP ParsecT
  Void Text Identity (Maybe Form -> Maybe Text -> Text -> Locus)
-> ParsecT Void Text Identity ()
-> ParsecT
     Void Text Identity (Maybe Form -> Maybe Text -> Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
space                                      -- molecule type
       ParsecT
  Void Text Identity (Maybe Form -> Maybe Text -> Text -> Locus)
-> ParsecT Void Text Identity (Maybe Form)
-> ParsecT Void Text Identity (Maybe Text -> Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Form
-> ParsecT Void Text Identity (Maybe Form)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Form
formP ParsecT Void Text Identity (Maybe Text -> Text -> Locus)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Maybe Text -> Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
space                               -- form of sequence
       ParsecT Void Text Identity (Maybe Text -> Text -> Locus)
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity (Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> Text
pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ((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
isUpper)) ParsecT Void Text Identity (Text -> Locus)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
space   -- GenBank division
       ParsecT Void Text Identity (Text -> Locus)
-> ParsecT Void Text Identity Text -> Parser Locus
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
textP                                               -- modification date
       Parser Locus -> ParsecT Void Text Identity () -> Parser Locus
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  ParsecT Void Text Identity ()
eolSpaceP)
  where
    textP :: ParsecT Void Text Identity (Tokens Text)
textP = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing ((Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text))
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace

    formP :: Parser Form
    formP :: ParsecT Void Text Identity Form
formP = ParsecT Void Text Identity Form -> ParsecT Void Text Identity Form
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"linear" ParsecT Void Text Identity Text
-> Form -> ParsecT Void Text Identity Form
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Form
Linear) ParsecT Void Text Identity Form
-> ParsecT Void Text Identity Form
-> ParsecT Void Text Identity Form
forall (f :: * -> *) a. Alternative f => f a -> f a -> f 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
"circular" ParsecT Void Text Identity Text
-> Form -> ParsecT Void Text Identity Form
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Form
Circular)

definitionP :: Parser Text
definitionP :: ParsecT Void Text Identity Text
definitionP =  Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"DEFINITION" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
space ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Text
emptyP ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Text
someLinesP)

accessionP :: Parser Text
accessionP :: ParsecT Void Text Identity Text
accessionP =  Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"ACCESSION" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
space ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Text
emptyP ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> Text
pack
          (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Char
alphaNumChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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
Token Text
'_')
          ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  ParsecT Void Text Identity ()
eolSpaceP))

versionP :: Parser Version
versionP :: ParsecT Void Text Identity Version
versionP =  Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"VERSION" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
space
         ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Version
-> ParsecT Void Text Identity Version
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((Text -> Maybe Text -> Version
Version (Text -> Maybe Text -> Version)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text -> Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
emptyP ParsecT Void Text Identity (Maybe Text -> Version)
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity Version
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing) ParsecT Void Text Identity Version
-> ParsecT Void Text Identity Version
-> ParsecT Void Text Identity Version
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Maybe Text -> Version
Version
        (Text -> Maybe Text -> Version)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text -> Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Text
pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity Char
versionP')
        ParsecT Void Text Identity (Maybe Text -> Version)
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity Version
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> Text
pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity ()
space ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"GI:" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity Char
versionP'))
        ParsecT Void Text Identity Version
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Version
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  ParsecT Void Text Identity ()
eolSpaceP))
  where
    versionP' :: ParsecT Void Text Identity Char
versionP' = ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Char
alphaNumChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (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
Token Text
'_') ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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
Token Text
'.'

keywordsP :: Parser Text
keywordsP :: ParsecT Void Text Identity Text
keywordsP =  Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"KEYWORDS"
          ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Text
emptyP
         ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT Void Text Identity ()
space ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
textWithSpacesP ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
eolSpaceP))

sourceP :: Parser Source
sourceP :: ParsecT Void Text Identity Source
sourceP =  Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"SOURCE" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
space
        ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Source
-> ParsecT Void Text Identity Source
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Maybe Text -> Source
Source
       (Text -> Maybe Text -> Source)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text -> Source)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
someLinesP
       ParsecT Void Text Identity (Maybe Text -> Source)
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity Source
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
organismP)
  where
    organismP :: ParsecT Void Text Identity Text
organismP = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"  ORGANISM" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
space ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
someLinesP

referenceP :: Parser Reference
referenceP :: ParsecT Void Text Identity Reference
referenceP = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"REFERENCE" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
space
           ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Reference
-> ParsecT Void Text Identity Reference
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (((\Text
x -> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Reference
Reference Text
x Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) (Text -> Reference)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Reference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
emptyP) ParsecT Void Text Identity Reference
-> ParsecT Void Text Identity Reference
-> ParsecT Void Text Identity Reference
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Reference
Reference
          (Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Reference)
-> ParsecT Void Text Identity Text
-> ParsecT
     Void
     Text
     Identity
     (Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
someLinesP
          ParsecT
  Void
  Text
  Identity
  (Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Reference)
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT
     Void
     Text
     Identity
     (Maybe Text -> Maybe Text -> Maybe Text -> Reference)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"  AUTHORS" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
space ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
someLinesP)
          ParsecT
  Void
  Text
  Identity
  (Maybe Text -> Maybe Text -> Maybe Text -> Reference)
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT
     Void Text Identity (Maybe Text -> Maybe Text -> Reference)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"  TITLE" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
space ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
someLinesP)
          ParsecT Void Text Identity (Maybe Text -> Maybe Text -> Reference)
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity (Maybe Text -> Reference)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"  JOURNAL" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
space ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
someLinesP)
          ParsecT Void Text Identity (Maybe Text -> Reference)
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity Reference
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"  PUBMED" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
space ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
someLinesP)))

commentP :: Parser Text
commentP :: ParsecT Void Text Identity Text
commentP = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"COMMENT" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Text
emptyP ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (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
Token Text
' ') ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
someLinesP))

--------------------------------------------------------------------------------
-- Block with FEATURES table.
--------------------------------------------------------------------------------

featuresP :: Parser [(Feature, Range)]
featuresP :: Parser [(Feature, Range)]
featuresP = -- skip unknown fields and stop on line with "FEATURES" 
          ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (ParsecT Void Text Identity Text
textWithSpacesP ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
eolSpaceP) (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"FEATURES") ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
space
          ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
textWithSpacesP ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
eolSpaceP
          ParsecT Void Text Identity Text
-> Parser [(Feature, Range)] -> Parser [(Feature, Range)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (Feature, Range)
-> Parser [(Feature, Range)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text Identity (Feature, Range)
featureP ParsecT Void Text Identity (Feature, Range)
-> String -> ParsecT Void Text Identity (Feature, Range)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Single feature parser")

featureP :: Parser (Feature, Range)
featureP :: ParsecT Void Text Identity (Feature, Range)
featureP = do
    Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
featureIndent1

    Text
featureName'      <- Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
space
    Range
range <- Parser Range
rangeP Parser Range -> ParsecT Void Text Identity () -> Parser Range
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
eolSpaceP

    [(Text, Text)]
props <- ParsecT Void Text Identity (Text, Text)
-> ParsecT Void Text Identity [(Text, Text)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity (Text, Text)
propsP

    -- Ranges are 1-based, but the underlying Vector in the Feature is 0-based.
    -- We shift the range left so the numberings match.
    --
    (Feature, Range) -> ParsecT Void Text Identity (Feature, Range)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [(Text, Text)] -> Feature
Feature Text
featureName' [(Text, Text)]
props, Int -> Range -> Range
shiftRange (-Int
1) Range
range)

rangeP :: Parser Range
rangeP :: Parser Range
rangeP =  Parser Range -> Parser Range
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Range
spanP 
      Parser Range -> Parser Range -> Parser Range
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Range -> Parser Range
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Range
betweenP 
      Parser Range -> Parser Range -> Parser Range
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Range -> Parser Range
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Range
pointP
      Parser Range -> Parser Range -> Parser Range
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Range -> Parser Range
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Range
joinP
      Parser Range -> Parser Range -> Parser Range
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Range
complementP
  where
    spanP :: Parser Range
    spanP :: Parser Range
spanP = do
        Border
lowerBorderType <- Border
-> ParsecT Void Text Identity Border
-> ParsecT Void Text Identity Border
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Border
Precise (ParsecT Void Text Identity Border
-> ParsecT Void Text Identity Border
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Border
 -> ParsecT Void Text Identity Border)
-> ParsecT Void Text Identity Border
-> ParsecT Void Text Identity Border
forall a b. (a -> b) -> a -> b
$ 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
Token Text
'<' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Border
-> ParsecT Void Text Identity Border
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Border -> ParsecT Void Text Identity Border
forall (f :: * -> *) a. Applicative f => a -> f a
pure Border
Exceeded)
        Int
lowerBorderLocation <- ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
        Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
".."
        Border
upperBorderType <- Border
-> ParsecT Void Text Identity Border
-> ParsecT Void Text Identity Border
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Border
Precise (ParsecT Void Text Identity Border
-> ParsecT Void Text Identity Border
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Border
 -> ParsecT Void Text Identity Border)
-> ParsecT Void Text Identity Border
-> ParsecT Void Text Identity Border
forall a b. (a -> b) -> a -> b
$ 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
Token Text
'>' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Border
-> ParsecT Void Text Identity Border
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Border -> ParsecT Void Text Identity Border
forall (f :: * -> *) a. Applicative f => a -> f a
pure Border
Exceeded)
        Int
upperBorderLocation <- ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
        Range -> Parser Range
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Range -> Parser Range) -> Range -> Parser Range
forall a b. (a -> b) -> a -> b
$ RangeBorder -> RangeBorder -> Range
Span (Border -> Int -> RangeBorder
RangeBorder Border
lowerBorderType Int
lowerBorderLocation) (Border -> Int -> RangeBorder
RangeBorder Border
upperBorderType Int
upperBorderLocation) 
                
    betweenP :: Parser Range
    betweenP :: Parser Range
betweenP = do
        Int
before <- ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
        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
Token Text
'^'
        Int
after <- ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
        Range -> Parser Range
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Range -> Parser Range) -> Range -> Parser Range
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Range
Between Int
before Int
after

    pointP :: Parser Range
    pointP :: Parser Range
pointP = (Int -> Range) -> ParsecT Void Text Identity Int -> Parser Range
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Range
Point ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
   
    joinP :: Parser Range
    joinP :: Parser Range
joinP = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"join(" ParsecT Void Text Identity Text -> Parser Range -> Parser Range
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Range] -> Range)
-> ParsecT Void Text Identity [Range] -> Parser Range
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Range] -> Range
Join (Parser Range
rangeP Parser Range
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [Range]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy1` 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
Token Text
',') Parser Range -> ParsecT Void Text Identity Char -> Parser Range
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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
Token Text
')'

    complementP :: Parser Range
    complementP :: Parser Range
complementP = (Range -> Range) -> Parser Range -> Parser Range
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Range
Complement (Parser Range -> Parser Range) -> Parser Range -> Parser Range
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"complement(" ParsecT Void Text Identity Text -> Parser Range -> Parser Range
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Range
rangeP Parser Range -> ParsecT Void Text Identity Char -> Parser Range
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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
Token Text
')'
        

propsP :: Parser (Text, Text)
propsP :: ParsecT Void Text Identity (Text, Text)
propsP = do
    Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
featureIndent2
    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
Token Text
'/'
    Text
propName <- Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=')
    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
Token Text
'='

    Text
propText <- ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ((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
Token Text
'\"' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\"') ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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
Token Text
'\"' ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
eolSpaceP)
             ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Text
multiLineProp)

    let propTextCorrect :: Text
propTextCorrect = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
featureIndent2) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
splitOn Text
featureIndent2 Text
propText

    (Text, Text) -> ParsecT Void Text Identity (Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
propName, Text
propTextCorrect)
  where
    indLine :: Parser Text
    indLine :: ParsecT Void Text Identity Text
indLine = do
        Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
featureIndent2
        ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (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
Token Text
'/')
        Text
text <- ParsecT Void Text Identity Text
textWithSpacesP 
        ParsecT Void Text Identity ()
eolSpaceP
        Text -> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
text

    multiLineProp :: Parser Text
    multiLineProp :: ParsecT Void Text Identity Text
multiLineProp = do
        Text
fstText <- ParsecT Void Text Identity Text
textWithSpacesP ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
eolSpaceP 
        [Text]
rest <- ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Text
indLine)
        Text -> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ParsecT Void Text Identity Text)
-> Text -> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat (Text
fstText Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
rest) 

    

-- | First level of identation in FEATURES table file.
--
featureIndent1 :: Text
featureIndent1 :: Text
featureIndent1 = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
5 Char
' '

-- | Second level of identation in FEATURES table file.
--
featureIndent2 :: Text
featureIndent2 :: Text
featureIndent2 = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
21 Char
' '

--------------------------------------------------------------------------------
-- Block with ORIGIN table.
--------------------------------------------------------------------------------

originP :: Parser String
originP :: ParsecT Void Text Identity String
originP =  (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"ORIGIN" ParsecT Void Text Identity Text
-> String -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"String ORIGIN") ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
eolSpaceP
        ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ([[String]] -> String)
-> ParsecT Void Text Identity ([[String]] -> String)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([[String]] -> String)
-> ParsecT Void Text Identity ([[String]] -> String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[String]] -> String
toText
       ParsecT Void Text Identity ([[String]] -> String)
-> ParsecT Void Text Identity [[String]]
-> ParsecT Void Text Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [String]
-> ParsecT Void Text Identity [[String]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text Identity ()
space ParsecT Void Text Identity ()
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar ParsecT Void Text Identity String
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
space1
        ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [String]
-> ParsecT Void Text Identity [String]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity String
-> ParsecT Void Text Identity [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar ParsecT Void Text Identity String
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity ()
space1 ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity ()
eolSpaceP)))
  where
    toText :: [[String]] -> String
    toText :: [[String]] -> String
toText = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([[String]] -> [String]) -> [[String]] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> String) -> [[String]] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat

--------------------------------------------------------------------------------
-- Parser of 'GenBankSequence' from FEATURES and ORIGIN tables.
--------------------------------------------------------------------------------
gbSeqP :: Parser (MarkedSequence Feature Char)
gbSeqP :: ParsecT Void Text Identity (MarkedSequence Feature Char)
gbSeqP = do
    [(Feature, Range)]
features <- (Parser [(Feature, Range)]
featuresP Parser [(Feature, Range)] -> String -> Parser [(Feature, Range)]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Features parser")

    -- An extract from the GB specification (https://www.ncbi.nlm.nih.gov/genbank/release/current/):
    --    NOTE: The BASE COUNT linetype is obsolete and was removed
    --    from the GenBank flatfile format in October 2003.
    --  Anyway, here, in 2021, we still might get plasmids with the BASE COUNT line present.
    --
    Maybe Text
_ <- ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity (Maybe Text))
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"BASE COUNT" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
textWithSpacesP ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol)

    String
origin   <- (ParsecT Void Text Identity String
originP 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
"Origin parser")

    (Text -> ParsecT Void Text Identity (MarkedSequence Feature Char))
-> (MarkedSequence Feature Char
    -> ParsecT Void Text Identity (MarkedSequence Feature Char))
-> Either Text (MarkedSequence Feature Char)
-> ParsecT Void Text Identity (MarkedSequence Feature Char)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ParsecT Void Text Identity (MarkedSequence Feature Char)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> ParsecT Void Text Identity (MarkedSequence Feature Char))
-> (Text -> String)
-> Text
-> ParsecT Void Text Identity (MarkedSequence Feature Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack) MarkedSequence Feature Char
-> ParsecT Void Text Identity (MarkedSequence Feature Char)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Element (MarkedSequence Feature Char)]
-> [(Marking (MarkedSequence Feature Char), Range)]
-> Either Text (MarkedSequence Feature Char)
forall s (m :: * -> *).
(IsMarkedSequence s, MonadError Text m) =>
[Element s] -> [(Marking s, Range)] -> m s
markedSequence String
[Element (MarkedSequence Feature Char)]
origin [(Marking (MarkedSequence Feature Char), Range)]
[(Feature, Range)]
features)

--------------------------------------------------------------------------------
-- Utility functions.
--------------------------------------------------------------------------------

-- | First level of identation in .gb file.
--
firstIndent :: Text
firstIndent :: Text
firstIndent = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
12 Char
' '

eolSpaceP :: Parser ()
eolSpaceP :: ParsecT Void Text Identity ()
eolSpaceP = () ()
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (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
Token Text
' ') ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Text
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol

emptyP :: Parser Text
emptyP :: ParsecT Void Text Identity Text
emptyP = ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (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
Token Text
' ') ParsecT Void Text Identity String
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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
Token Text
'.' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
eolSpaceP ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"."

textWithSpacesP :: Parser Text
textWithSpacesP :: ParsecT Void Text Identity Text
textWithSpacesP = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'\n', Char
'\r'])

someLinesP :: Parser Text
someLinesP :: ParsecT Void Text Identity Text
someLinesP = Text -> [Text] -> Text
intercalate Text
"\n" ([Text] -> Text)
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT Void Text Identity [Text]
someLinesIndentP Text
firstIndent

someLinesIndentP :: Text -> Parser [Text]
someLinesIndentP :: Text -> ParsecT Void Text Identity [Text]
someLinesIndentP Text
indent =  (:) (Text -> [Text] -> [Text])
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity ([Text] -> [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
textWithSpacesP ParsecT Void Text Identity ([Text] -> [Text])
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ([Text] -> [Text])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
eolSpaceP
                       ParsecT Void Text Identity ([Text] -> [Text])
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity [Text]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
indent ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
textWithSpacesP ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
eolSpaceP))

space :: Parser ()
space :: ParsecT Void Text Identity ()
space = () ()
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity String)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall a b. (a -> b) -> a -> 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
isSpace)

space1 :: Parser ()
space1 :: ParsecT Void Text Identity ()
space1 = () ()
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity String)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall a b. (a -> b) -> a -> 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
isSpace)

alphaNumChar :: Parser Char
alphaNumChar :: ParsecT Void Text Identity Char
alphaNumChar = (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
isAlphaNum