module Bio.FASTA.Writer
  ( fastaToText
  , WritableFastaToken (..)
  ) where

import Bio.FASTA.Type  (Fasta, FastaItem (..), ModItem (..), modificationToString)
import Bio.Sequence    (BareSequence, sequ)
import Control.Lens    ((^.))
import Data.List.Split (chunksOf)
import Data.Text       (Text, pack)
import Data.Vector     (Vector, toList)
import Prelude         hiding (drop)

class WritableFastaToken a where
    tokenToString :: a -> String

instance WritableFastaToken Char where
    tokenToString :: Char -> String
tokenToString = Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance WritableFastaToken ModItem where
    tokenToString :: ModItem -> String
tokenToString (Letter Char
l) = [Char
l]
    tokenToString (Mod Modification
m)    = Modification -> String
modificationToString Modification
m

fastaToText :: WritableFastaToken a => Fasta a -> Text
fastaToText :: Fasta a -> Text
fastaToText Fasta a
f = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (FastaItem a -> Text) -> Fasta a -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FastaItem a -> Text
forall a. WritableFastaToken a => FastaItem a -> Text
writeItem Fasta a
f

writeItem :: WritableFastaToken a => FastaItem a -> Text
writeItem :: FastaItem a -> Text
writeItem (FastaItem Text
name BareSequence a
s) = Text
">" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BareSequence a -> Text
forall a. WritableFastaToken a => BareSequence a -> Text
seq2Text BareSequence a
s

seq2Text :: WritableFastaToken a => BareSequence a -> Text
seq2Text :: BareSequence a -> Text
seq2Text BareSequence a
s = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Vector a -> String
forall a. WritableFastaToken a => Vector a -> String
vector2Text (Vector a -> String) -> Vector a -> String
forall a b. (a -> b) -> a -> b
$ BareSequence a
s BareSequence a
-> Getting (Vector a) (BareSequence a) (Vector a) -> Vector a
forall s a. s -> Getting a s a -> a
^. Getting (Vector a) (BareSequence a) (Vector a)
forall mk w a. Getter (Sequence mk w a) (Vector a)
Bio.Sequence.sequ

vector2Text :: WritableFastaToken a => Vector a -> String
vector2Text :: Vector a -> String
vector2Text Vector a
v = (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String]
forall e. Int -> [e] -> [[e]]
chunksOf Int
80 (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ (a -> String) -> [a] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap a -> String
forall a. WritableFastaToken a => a -> String
tokenToString ([a] -> String) -> [a] -> String
forall a b. (a -> b) -> a -> b
$ Vector a -> [a]
forall a. Vector a -> [a]
toList Vector a
v