module Bio.FASTA.Parser
  ( fastaP
  , fastaPGeneric
  ) where

import Bio.FASTA.Type       (Fasta, FastaItem (..))
import Bio.Sequence         (BareSequence, bareSequence)
import Data.Attoparsec.Text (Parser, char, choice, endOfInput, endOfLine, many', many1', satisfy,
                             skipWhile, takeWhile)
import Data.Char            (isLetter, isSpace)
import Data.Text            (Text, strip)
import Prelude              hiding (takeWhile)

-- | Parser of .fasta file.
--
fastaP :: Parser (Fasta Char)
fastaP :: Parser (Fasta Char)
fastaP = (Char -> Bool) -> Parser (Fasta Char)
fastaPGeneric Char -> Bool
isLetter

fastaPGeneric :: (Char -> Bool) -> Parser (Fasta Char)
fastaPGeneric :: (Char -> Bool) -> Parser (Fasta Char)
fastaPGeneric = Parser Text (FastaItem Char) -> Parser (Fasta Char)
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (Parser Text (FastaItem Char) -> Parser (Fasta Char))
-> ((Char -> Bool) -> Parser Text (FastaItem Char))
-> (Char -> Bool)
-> Parser (Fasta Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Parser Text (FastaItem Char)
item

item :: (Char -> Bool) -> Parser (FastaItem Char)
item :: (Char -> Bool) -> Parser Text (FastaItem Char)
item Char -> Bool
predicate = (Text -> BareSequence Char -> FastaItem Char
forall a. Text -> BareSequence a -> FastaItem a
FastaItem (Text -> BareSequence Char -> FastaItem Char)
-> Parser Text Text
-> Parser Text (BareSequence Char -> FastaItem Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
seqName Parser Text (BareSequence Char -> FastaItem Char)
-> Parser Text (BareSequence Char) -> Parser Text (FastaItem Char)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Bool) -> Parser Text (BareSequence Char)
fastaSeq Char -> Bool
predicate) Parser Text (FastaItem Char)
-> Parser Text () -> Parser Text (FastaItem Char)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser Text ()
skipWhile Char -> Bool
isSpace

seqName :: Parser Text
seqName :: Parser Text Text
seqName = Text -> Text
strip (Text -> Text) -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
char Char
'>' Parser Char -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
tabs Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text Text
takeWhile (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'\n', Char
'\r']) Parser Text Text -> Parser Text () -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
tabs Parser Text Text -> Parser Text () -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
eol)

fastaSeq :: (Char -> Bool) -> Parser (BareSequence Char)
fastaSeq :: (Char -> Bool) -> Parser Text (BareSequence Char)
fastaSeq Char -> Bool
predicate = [Char] -> BareSequence Char
forall s. IsBareSequence s => [Element s] -> s
bareSequence ([Char] -> BareSequence Char)
-> ([[Char]] -> [Char]) -> [[Char]] -> BareSequence Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat ([[Char]] -> BareSequence Char)
-> Parser Text [[Char]] -> Parser Text (BareSequence Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text [Char] -> Parser Text [[Char]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' ((Char -> Bool) -> Parser Text [Char]
line Char -> Bool
predicate)

line :: (Char -> Bool) -> Parser String
line :: (Char -> Bool) -> Parser Text [Char]
line Char -> Bool
predicate = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char]) -> Parser Text [[Char]] -> Parser Text [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text [Char] -> Parser Text [[Char]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' (Parser Char -> Parser Text [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' ((Char -> Bool) -> Parser Char
satisfy Char -> Bool
predicate) Parser Text [Char] -> Parser Text [Char] -> Parser Text [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char -> Parser Text [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (Char -> Parser Char
char Char
' ')) Parser Text [Char] -> Parser Text () -> Parser Text [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
eol

eol :: Parser ()
eol :: Parser Text ()
eol = Parser Text ()
tabs Parser Text () -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Parser Text ()] -> Parser Text ()
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [Parser Text ()
slashN, Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput]

slashN :: Parser ()
slashN :: Parser Text ()
slashN = () () -> Parser Text [()] -> Parser Text ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text () -> Parser Text [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' Parser Text ()
endOfLine

tabs :: Parser ()
tabs :: Parser Text ()
tabs = () () -> Parser Text [Char] -> Parser Text ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Char -> Parser Text [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (Char -> Parser Char
char Char
'\t')