{-# LANGUAGE OverloadedStrings #-}

module Bio.GB.Parser
  ( genBankP
  ) where

import Bio.GB.Type                (Feature (..), Form (..), GenBankSequence (..), Locus (..),
                                   Meta (..), Reference (..), Source (..), Version (..))
import Bio.Sequence               (MarkedSequence, Range, markedSequence)
import Control.Applicative        ((<|>))
import Data.Attoparsec.Combinator (manyTill)
import Data.Attoparsec.Text       (Parser, char, decimal, digit, endOfInput, endOfLine, letter,
                                   many', many1', satisfy, string, takeWhile, takeWhile1)
import Data.Bifunctor             (bimap)
import Data.Char                  (isAlphaNum, isSpace, isUpper)
import Data.Functor               (($>))
import Data.Text                  (Text, intercalate, pack, splitOn, unpack)
import Prelude                    hiding (takeWhile)

-- | Parser of .gb file.
--
genBankP :: Parser GenBankSequence
genBankP :: Parser GenBankSequence
genBankP =  Meta -> MarkedSequence Feature Char -> GenBankSequence
GenBankSequence
        (Meta -> MarkedSequence Feature Char -> GenBankSequence)
-> Parser Text Meta
-> Parser Text (MarkedSequence Feature Char -> GenBankSequence)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Meta
metaP
        Parser Text (MarkedSequence Feature Char -> GenBankSequence)
-> Parser Text (MarkedSequence Feature Char)
-> Parser GenBankSequence
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text (MarkedSequence Feature Char)
gbSeqP
        Parser GenBankSequence
-> Parser Text Text -> Parser GenBankSequence
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Text -> Parser Text Text
string Text
"//" Parser GenBankSequence -> Parser Text () -> Parser GenBankSequence
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
eolSpaceP Parser GenBankSequence -> Parser Text () -> Parser GenBankSequence
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput

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

metaP :: Parser Meta
metaP :: Parser Text Meta
metaP = do
  Locus
locus'      <- Parser Locus
locusP

  Maybe Text
definitionM <- Parser Text Text -> Parser (Maybe Text)
forall a. Parser a -> Parser (Maybe a)
wrapMP Parser Text Text
definitionP
  Maybe Text
accessionM  <- Parser Text Text -> Parser (Maybe Text)
forall a. Parser a -> Parser (Maybe a)
wrapMP Parser Text Text
accessionP
  Maybe Version
versionM    <- Parser Version -> Parser (Maybe Version)
forall a. Parser a -> Parser (Maybe a)
wrapMP Parser Version
versionP
  Maybe Text
keywordsM   <- Parser Text Text -> Parser (Maybe Text)
forall a. Parser a -> Parser (Maybe a)
wrapMP Parser Text Text
keywordsP
  Maybe Source
sourceM     <- Parser Source -> Parser (Maybe Source)
forall a. Parser a -> Parser (Maybe a)
wrapMP Parser Source
sourceP
  [Reference]
referencesL <- Parser Text Reference -> Parser Text [Reference]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text Reference
referenceP
  [Text]
commentsL   <- Parser Text Text -> Parser Text [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text Text
commentP

  Meta -> Parser Text Meta
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Meta -> Parser Text Meta) -> Meta -> Parser Text 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 = Text -> Parser Text Text
string Text
"LOCUS" Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
space Parser Text () -> 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)
-> Parser Text Text
-> Parser
     Text (Int -> Text -> Maybe Form -> Maybe Text -> Text -> Locus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
textP Parser
  Text (Int -> Text -> Maybe Form -> Maybe Text -> Text -> Locus)
-> Parser Text ()
-> Parser
     Text (Int -> Text -> Maybe Form -> Maybe Text -> Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
space                                      -- name
       Parser
  Text (Int -> Text -> Maybe Form -> Maybe Text -> Text -> Locus)
-> Parser Text Int
-> Parser Text (Text -> Maybe Form -> Maybe Text -> Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Int
forall a. Integral a => Parser a
decimal Parser Text (Text -> Maybe Form -> Maybe Text -> Text -> Locus)
-> Parser Text ()
-> Parser Text (Text -> Maybe Form -> Maybe Text -> Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
space Parser Text (Text -> Maybe Form -> Maybe Text -> Text -> Locus)
-> Parser Text Text
-> Parser Text (Text -> Maybe Form -> Maybe Text -> Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
string Text
"bp" Parser Text (Text -> Maybe Form -> Maybe Text -> Text -> Locus)
-> Parser Text ()
-> Parser Text (Text -> Maybe Form -> Maybe Text -> Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
space            -- sequence length
       Parser Text (Text -> Maybe Form -> Maybe Text -> Text -> Locus)
-> Parser Text Text
-> Parser Text (Maybe Form -> Maybe Text -> Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text
textP Parser Text (Maybe Form -> Maybe Text -> Text -> Locus)
-> Parser Text ()
-> Parser Text (Maybe Form -> Maybe Text -> Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
space                                      -- molecule type
       Parser Text (Maybe Form -> Maybe Text -> Text -> Locus)
-> Parser Text (Maybe Form)
-> Parser Text (Maybe Text -> Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Form -> Parser Text (Maybe Form)
forall a. Parser a -> Parser (Maybe a)
wrapMP Parser Form
formP Parser Text (Maybe Text -> Text -> Locus)
-> Parser Text () -> Parser Text (Maybe Text -> Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
space                               -- form of sequence
       Parser Text (Maybe Text -> Text -> Locus)
-> Parser (Maybe Text) -> Parser Text (Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text -> Parser (Maybe Text)
forall a. Parser a -> Parser (Maybe a)
wrapMP (String -> Text
pack (String -> Text) -> Parser Text String -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' ((Char -> Bool) -> Parser Text Char
satisfy Char -> Bool
isUpper)) Parser Text (Text -> Locus)
-> Parser Text () -> Parser Text (Text -> Locus)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
space -- GenBank division
       Parser Text (Text -> Locus) -> Parser Text Text -> Parser Locus
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text
textP                                               -- modification date
       Parser Locus -> Parser Text () -> Parser Locus
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Parser Text ()
eolSpaceP)
  where
    textP :: Parser Text Text
textP = (Char -> Bool) -> Parser Text Text
takeWhile1 ((Char -> Bool) -> Parser Text Text)
-> (Char -> Bool) -> Parser Text 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 :: Parser Form
formP = (Text -> Parser Text Text
string Text
"linear" Parser Text Text -> Form -> Parser Form
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Form
Linear) Parser Form -> Parser Form -> Parser Form
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser Text Text
string Text
"circular" Parser Text Text -> Form -> Parser Form
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Form
Circular)

definitionP :: Parser Text
definitionP :: Parser Text Text
definitionP =  Text -> Parser Text Text
string Text
"DEFINITION" Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
space Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Text Text
emptyP Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
someLinesP)

accessionP :: Parser Text
accessionP :: Parser Text Text
accessionP =  Text -> Parser Text Text
string Text
"ACCESSION" Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
space Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Text Text
emptyP Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> Text
pack
          (String -> Text) -> Parser Text String -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' (Parser Text Char
alphaNumChar Parser Text Char -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Text Char
char Char
'_')
          Parser Text Text -> Parser Text () -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Parser Text ()
eolSpaceP))

versionP :: Parser Version
versionP :: Parser Version
versionP =  Text -> Parser Text Text
string Text
"VERSION" Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
space
         Parser Text () -> Parser Version -> Parser Version
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((Text -> Maybe Text -> Version
Version (Text -> Maybe Text -> Version)
-> Parser Text Text -> Parser Text (Maybe Text -> Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
emptyP Parser Text (Maybe Text -> Version)
-> Parser (Maybe Text) -> Parser Version
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing) Parser Version -> Parser Version -> Parser Version
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Maybe Text -> Version
Version
        (Text -> Maybe Text -> Version)
-> Parser Text Text -> Parser Text (Maybe Text -> Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Text
pack (String -> Text) -> Parser Text String -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' Parser Text Char
versionP')
        Parser Text (Maybe Text -> Version)
-> Parser (Maybe Text) -> Parser Version
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text -> Parser (Maybe Text)
forall a. Parser a -> Parser (Maybe a)
wrapMP (String -> Text
pack (String -> Text) -> Parser Text String -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text ()
space Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text Text
string Text
"GI:" Parser Text Text -> Parser Text String -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' Parser Text Char
versionP'))
        Parser Version -> Parser Text () -> Parser Version
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Parser Text ()
eolSpaceP))
  where
    versionP' :: Parser Text Char
versionP' = Parser Text Char
alphaNumChar Parser Text Char -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Text Char
char Char
'_' Parser Text Char -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Text Char
char Char
'.'

keywordsP :: Parser Text
keywordsP :: Parser Text Text
keywordsP =  Text -> Parser Text Text
string Text
"KEYWORDS"
          Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Text Text
emptyP
         Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser Text ()
space Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
textWithSpacesP Parser Text Text -> Parser Text () -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
eolSpaceP))

sourceP :: Parser Source
sourceP :: Parser Source
sourceP =  Text -> Parser Text Text
string Text
"SOURCE" Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
space
        Parser Text () -> Parser Source -> Parser Source
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Maybe Text -> Source
Source
       (Text -> Maybe Text -> Source)
-> Parser Text Text -> Parser Text (Maybe Text -> Source)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
someLinesP
       Parser Text (Maybe Text -> Source)
-> Parser (Maybe Text) -> Parser Source
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text -> Parser (Maybe Text)
forall a. Parser a -> Parser (Maybe a)
wrapMP Parser Text Text
organismP)
  where
    organismP :: Parser Text Text
organismP = Text -> Parser Text Text
string Text
"  ORGANISM" Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
space Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
someLinesP

referenceP :: Parser Reference
referenceP :: Parser Text Reference
referenceP = Text -> Parser Text Text
string Text
"REFERENCE" Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
space
           Parser Text () -> Parser Text Reference -> Parser Text 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) -> Parser Text Text -> Parser Text Reference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
emptyP) Parser Text Reference
-> Parser Text Reference -> Parser Text 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)
-> Parser Text Text
-> Parser
     Text
     (Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
someLinesP
          Parser
  Text
  (Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Reference)
-> Parser (Maybe Text)
-> Parser
     Text (Maybe Text -> Maybe Text -> Maybe Text -> Reference)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text -> Parser (Maybe Text)
forall a. Parser a -> Parser (Maybe a)
wrapMP (Text -> Parser Text Text
string Text
"  AUTHORS" Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
space Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
someLinesP)
          Parser Text (Maybe Text -> Maybe Text -> Maybe Text -> Reference)
-> Parser (Maybe Text)
-> Parser Text (Maybe Text -> Maybe Text -> Reference)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text -> Parser (Maybe Text)
forall a. Parser a -> Parser (Maybe a)
wrapMP (Text -> Parser Text Text
string Text
"  TITLE" Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
space Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
someLinesP)
          Parser Text (Maybe Text -> Maybe Text -> Reference)
-> Parser (Maybe Text) -> Parser Text (Maybe Text -> Reference)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text -> Parser (Maybe Text)
forall a. Parser a -> Parser (Maybe a)
wrapMP (Text -> Parser Text Text
string Text
"  JOURNAL" Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
space Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
someLinesP)
          Parser Text (Maybe Text -> Reference)
-> Parser (Maybe Text) -> Parser Text Reference
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text -> Parser (Maybe Text)
forall a. Parser a -> Parser (Maybe a)
wrapMP (Text -> Parser Text Text
string Text
"  PUBMED" Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
space Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
someLinesP)))

commentP :: Parser Text
commentP :: Parser Text Text
commentP = Text -> Parser Text Text
string Text
"COMMENT" Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Text Text
emptyP Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser Text Char -> Parser Text String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (Char -> Parser Text Char
char Char
' ') Parser Text String -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
someLinesP))

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

featuresP :: Parser [(Feature, Range)]
featuresP :: Parser [(Feature, Range)]
featuresP = -- skip unknown fields and stop on line with "FEATURES" 
          Parser Text Text -> Parser Text Text -> Parser Text [Text]
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill (Parser Text Text
textWithSpacesP Parser Text Text -> Parser Text () -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
eolSpaceP) (Text -> Parser Text Text
string Text
"FEATURES") Parser Text [Text] -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
space
          Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
textWithSpacesP Parser Text Text -> Parser Text () -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
eolSpaceP
          Parser Text Text
-> Parser [(Feature, Range)] -> Parser [(Feature, Range)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text (Feature, Range) -> Parser [(Feature, Range)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' Parser Text (Feature, Range)
featureP

featureP :: Parser (Feature, Range)
featureP :: Parser Text (Feature, Range)
featureP = do
    Text
_ <- Text -> Parser Text Text
string Text
featureIndent1

    Text
featureName'      <- (Char -> Bool) -> Parser Text Text
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) Parser Text Text -> Parser Text () -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
space
    (Bool
strand53, Range
range) <- Parser (Bool, Range)
rangeP Parser (Bool, Range) -> Parser Text () -> Parser (Bool, Range)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
eolSpaceP

    [(Text, Text)]
props <- Parser Text (Text, Text) -> Parser Text [(Text, Text)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' Parser Text (Text, Text)
propsP

    (Feature, Range) -> Parser Text (Feature, Range)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Bool -> [(Text, Text)] -> Feature
Feature Text
featureName' Bool
strand53 [(Text, Text)]
props, Range
range)

rangeP :: Parser (Bool, Range)
rangeP :: Parser (Bool, Range)
rangeP =  (Text -> Parser Text Text
string Text
"complement(" Parser Text Text -> Parser (Bool, Range) -> Parser (Bool, Range)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Parser (Bool, Range)
rP Bool
False Parser (Bool, Range) -> Parser Text Char -> Parser (Bool, Range)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
')') Parser (Bool, Range)
-> Parser (Bool, Range) -> Parser (Bool, Range)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser (Bool, Range)
rP Bool
True
  where
    rP :: Bool -> Parser (Bool, Range)
    rP :: Bool -> Parser (Bool, Range)
rP Bool
b =  (Range -> Range) -> (Bool, Range) -> (Bool, Range)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Int) -> (Int -> Int) -> Range -> Range
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Int -> Int
forall a. Enum a => a -> a
pred Int -> Int
forall a. a -> a
id)
        ((Bool, Range) -> (Bool, Range))
-> (Range -> (Bool, Range)) -> Range -> (Bool, Range)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (,) Bool
b
        (Range -> (Bool, Range))
-> Parser Text Range -> Parser (Bool, Range)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((,) (Int -> Int -> Range)
-> Parser Text Int -> Parser Text (Int -> Range)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Int
forall a. Integral a => Parser a
decimal Parser Text (Int -> Range)
-> Parser Text Text -> Parser Text (Int -> Range)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
string Text
".." Parser Text (Int -> Range) -> Parser Text Int -> Parser Text Range
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Int
forall a. Integral a => Parser a
decimal) Parser Text Range -> Parser Text Range -> Parser Text Range
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((\Int
x -> (Int
x, Int
x)) (Int -> Range) -> Parser Text Int -> Parser Text Range
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Int
forall a. Integral a => Parser a
decimal))

propsP :: Parser (Text, Text)
propsP :: Parser Text (Text, Text)
propsP = do
    Text
_ <- Text -> Parser Text Text
string Text
featureIndent2
    Char
_ <- Char -> Parser Text Char
char Char
'/'
    Text
propName <- (Char -> Bool) -> Parser Text Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=')
    Char
_ <- Char -> Parser Text Char
char Char
'='

    Text
propText <- ((Char -> Parser Text Char
char Char
'\"' Parser Text Char -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\"') Parser Text Text -> Parser Text Char -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
'\"')
             Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
textWithSpacesP)
             Parser Text Text -> Parser Text () -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
eolSpaceP

    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) -> Parser Text (Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
propName, Text
propTextCorrect)

-- | 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 :: Parser Text String
originP =  Text -> Parser Text Text
string Text
"ORIGIN" Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
eolSpaceP
        Parser Text ()
-> Parser Text ([[String]] -> String)
-> Parser Text ([[String]] -> String)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([[String]] -> String) -> Parser Text ([[String]] -> String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[String]] -> String
toText
       Parser Text ([[String]] -> String)
-> Parser Text [[String]] -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text [String] -> Parser Text [[String]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' (Parser Text ()
space Parser Text () -> Parser Text String -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' Parser Text Char
digit Parser Text String -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
space1
        Parser Text () -> Parser Text [String] -> Parser Text [String]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text String -> Parser Text [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' (Parser Text Char -> Parser Text String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' Parser Text Char
letter Parser Text String -> Parser Text () -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser Text ()
space1 Parser Text () -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text ()
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 :: Parser Text (MarkedSequence Feature Char)
gbSeqP = do
    [(Feature, Range)]
features <- Parser [(Feature, Range)]
featuresP
    String
origin   <- Parser Text String
originP

    (Text -> Parser Text (MarkedSequence Feature Char))
-> (MarkedSequence Feature Char
    -> Parser Text (MarkedSequence Feature Char))
-> Either Text (MarkedSequence Feature Char)
-> Parser Text (MarkedSequence Feature Char)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser Text (MarkedSequence Feature Char)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Text (MarkedSequence Feature Char))
-> (Text -> String)
-> Text
-> Parser Text (MarkedSequence Feature Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack) MarkedSequence Feature Char
-> Parser Text (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 :: Parser Text ()
eolSpaceP = () () -> Parser Text String -> Parser Text ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text Char -> Parser Text String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (Char -> Parser Text Char
char Char
' ') Parser Text () -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
endOfLine

emptyP :: Parser Text
emptyP :: Parser Text Text
emptyP = Parser Text Char -> Parser Text String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (Char -> Parser Text Char
char Char
' ') Parser Text String -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Text Char
char Char
'.' Parser Text Char -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
eolSpaceP Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"."

textWithSpacesP :: Parser Text
textWithSpacesP :: Parser Text Text
textWithSpacesP = (Char -> Bool) -> Parser Text Text
takeWhile (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'\n', Char
'\r'])

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

someLinesIndentP :: Text -> Parser [Text]
someLinesIndentP :: Text -> Parser Text [Text]
someLinesIndentP Text
indent =  (:) (Text -> [Text] -> [Text])
-> Parser Text Text -> Parser Text ([Text] -> [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
textWithSpacesP Parser Text ([Text] -> [Text])
-> Parser Text () -> Parser Text ([Text] -> [Text])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
eolSpaceP
                       Parser Text ([Text] -> [Text])
-> Parser Text [Text] -> Parser Text [Text]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text Text -> Parser Text [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (Text -> Parser Text Text
string Text
indent Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
textWithSpacesP Parser Text Text -> Parser Text () -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
eolSpaceP))

wrapMP :: Parser a -> Parser (Maybe a)
wrapMP :: Parser a -> Parser (Maybe a)
wrapMP Parser a
p = (a -> Maybe a) -> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just Parser a
p Parser (Maybe a) -> Parser (Maybe a) -> Parser (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

space :: Parser ()
space :: Parser Text ()
space = () () -> Parser Text String -> Parser Text ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Parser Text Char -> Parser Text String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (Parser Text Char -> Parser Text String)
-> Parser Text Char -> Parser Text String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Text Char
satisfy Char -> Bool
isSpace)

space1 :: Parser ()
space1 :: Parser Text ()
space1 = () () -> Parser Text String -> Parser Text ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Parser Text Char -> Parser Text String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' (Parser Text Char -> Parser Text String)
-> Parser Text Char -> Parser Text String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Text Char
satisfy Char -> Bool
isSpace)

alphaNumChar :: Parser Char
alphaNumChar :: Parser Text Char
alphaNumChar = (Char -> Bool) -> Parser Text Char
satisfy Char -> Bool
isAlphaNum