module Bio.FASTA.Type
  ( Fasta
  , FastaItem (..)
  ) where

import           Bio.Sequence (BareSequence)
import           Data.Text    (Text)

-- | Type alias for FASTA file.
--  satisfies the following format : >(\s|\t)*[^\n\r]+(\s|\t)*(\n|\r)*((\w|\s)(\n|\r)*)*
--
type Fasta a = [FastaItem a]

-- | One record in FASTA file.
--
data FastaItem a
   = FastaItem { FastaItem a -> Text
name :: Text           -- ^ name of the sequence
               , FastaItem a -> BareSequence a
sequ :: BareSequence a -- ^ bare sequence
               }
  deriving (FastaItem a -> FastaItem a -> Bool
(FastaItem a -> FastaItem a -> Bool)
-> (FastaItem a -> FastaItem a -> Bool) -> Eq (FastaItem a)
forall a. Eq a => FastaItem a -> FastaItem a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FastaItem a -> FastaItem a -> Bool
$c/= :: forall a. Eq a => FastaItem a -> FastaItem a -> Bool
== :: FastaItem a -> FastaItem a -> Bool
$c== :: forall a. Eq a => FastaItem a -> FastaItem a -> Bool
Eq, Int -> FastaItem a -> ShowS
[FastaItem a] -> ShowS
FastaItem a -> String
(Int -> FastaItem a -> ShowS)
-> (FastaItem a -> String)
-> ([FastaItem a] -> ShowS)
-> Show (FastaItem a)
forall a. Show a => Int -> FastaItem a -> ShowS
forall a. Show a => [FastaItem a] -> ShowS
forall a. Show a => FastaItem a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FastaItem a] -> ShowS
$cshowList :: forall a. Show a => [FastaItem a] -> ShowS
show :: FastaItem a -> String
$cshow :: forall a. Show a => FastaItem a -> String
showsPrec :: Int -> FastaItem a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FastaItem a -> ShowS
Show, a -> FastaItem b -> FastaItem a
(a -> b) -> FastaItem a -> FastaItem b
(forall a b. (a -> b) -> FastaItem a -> FastaItem b)
-> (forall a b. a -> FastaItem b -> FastaItem a)
-> Functor FastaItem
forall a b. a -> FastaItem b -> FastaItem a
forall a b. (a -> b) -> FastaItem a -> FastaItem b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> FastaItem b -> FastaItem a
$c<$ :: forall a b. a -> FastaItem b -> FastaItem a
fmap :: (a -> b) -> FastaItem a -> FastaItem b
$cfmap :: forall a b. (a -> b) -> FastaItem a -> FastaItem b
Functor)