{-# 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)
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
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
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
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
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
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
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
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
= 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))
featuresP :: Parser [(Feature, Range)]
featuresP :: Parser [(Feature, Range)]
featuresP =
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)
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
' '
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
' '
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
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)
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