module Bio.GB.Writer
( genBankToText
) where
import Bio.GB.Type (Feature (..), GenBankSequence (..), Locus (..), Meta (..),
Reference (..), Source (..), Version (..))
import Bio.Sequence (Border (..), Range (..), RangeBorder (..), markings, shiftRange,
toList)
import Control.Lens ((^.))
import qualified Data.List.Split as S (chunksOf)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T (append, chunksOf, intercalate, length, lines, null, pack,
toLower, unwords)
genBankToText :: GenBankSequence -> Text
genBankToText :: GenBankSequence -> Text
genBankToText GenBankSequence{MarkedSequence Feature Char
Meta
gbSeq :: GenBankSequence -> MarkedSequence Feature Char
meta :: GenBankSequence -> Meta
gbSeq :: MarkedSequence Feature Char
meta :: Meta
..} = [Text] -> Text
interNewLine [Text]
parts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
where
parts :: [Text]
parts = [ Meta -> Text
metaToText Meta
meta
, [(Feature, Range)] -> Text
featuresToText ([(Feature, Range)] -> Text) -> [(Feature, Range)] -> Text
forall a b. (a -> b) -> a -> b
$ MarkedSequence Feature Char
gbSeq MarkedSequence Feature Char
-> Getting
[(Feature, Range)] (MarkedSequence Feature Char) [(Feature, Range)]
-> [(Feature, Range)]
forall s a. s -> Getting a s a -> a
^. Getting
[(Feature, Range)] (MarkedSequence Feature Char) [(Feature, Range)]
forall mk w a. Getter (Sequence mk w a) [(mk, Range)]
markings
, Text -> Text
originToText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ MarkedSequence Feature Char
-> [Element (MarkedSequence Feature Char)]
forall s. IsSequence s => s -> [Element s]
toList MarkedSequence Feature Char
gbSeq
, Text
"//"
]
metaToText :: Meta -> Text
metaToText :: Meta -> Text
metaToText Meta{[Text]
[Reference]
Maybe Text
Maybe Source
Maybe Version
Locus
comments :: Meta -> [Text]
references :: Meta -> [Reference]
source :: Meta -> Maybe Source
keywords :: Meta -> Maybe Text
version :: Meta -> Maybe Version
accession :: Meta -> Maybe Text
definition :: Meta -> Maybe Text
locus :: Meta -> Locus
comments :: [Text]
references :: [Reference]
source :: Maybe Source
keywords :: Maybe Text
version :: Maybe Version
accession :: Maybe Text
definition :: Maybe Text
locus :: Locus
..} = [Text] -> Text
interNewLine [Text]
parts
where
parts :: [Text]
parts = [ Locus -> Text
locusToText Locus
locus
, Maybe Text -> Text
textFromMaybe (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text -> Text
processMany Int
metaIndent Text
"DEFINITION") Maybe Text
definition
, Maybe Text -> Text
textFromMaybe (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text -> Text
processMany Int
metaIndent Text
"ACCESSION") Maybe Text
accession
, Maybe Text -> Text
textFromMaybe (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ (Version -> Text) -> Maybe Version -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> Text
versionToText Maybe Version
version
, Maybe Text -> Text
textFromMaybe (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text -> Text
processMany Int
metaIndent Text
"KEYWORDS") Maybe Text
keywords
, Maybe Text -> Text
textFromMaybe (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ (Source -> Text) -> Maybe Source -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Source -> Text
sourceToText Maybe Source
source
]
[Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Reference -> Text) -> [Reference] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Reference -> Text
referenceToText [Reference]
references
[Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text -> Text
processMany Int
metaIndent Text
"COMMENT") [Text]
comments
locusToText :: Locus -> Text
locusToText :: Locus -> Text
locusToText Locus{Int
Maybe Text
Maybe Form
Text
modificationDate :: Locus -> Text
gbDivision :: Locus -> Maybe Text
form :: Locus -> Maybe Form
molType :: Locus -> Text
len :: Locus -> Int
name :: Locus -> Text
modificationDate :: Text
gbDivision :: Maybe Text
form :: Maybe Form
molType :: Text
len :: Int
name :: Text
..} = Int -> Text -> Text
toIndent Int
metaIndent Text
"LOCUS" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
locusText
where
locusList :: [Text]
locusList = [ Text
name
, Int -> Text
forall a. Show a => a -> Text
showText Int
len Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" bp"
, Text
molType
, Maybe Text -> Text
textFromMaybe (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ (Form -> Text) -> Maybe Form -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text
T.toLower (Text -> Text) -> (Form -> Text) -> Form -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Form -> Text
forall a. Show a => a -> Text
showText) Maybe Form
form
, Maybe Text -> Text
textFromMaybe Maybe Text
gbDivision
, Text
modificationDate
]
locusText :: Text
locusText = Text -> [Text] -> Text
T.intercalate (Int -> Text
spaces Int
5) ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [Text]
locusList
sourceToText :: Source -> Text
sourceToText :: Source -> Text
sourceToText Source{Maybe Text
Text
organism :: Source -> Maybe Text
sourceT :: Source -> Text
organism :: Maybe Text
sourceT :: Text
..} = [Text] -> Text
interNewLine ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
mainPart Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Text
textFromMaybe Maybe Text
organismPart)
where
mainPart :: Text
mainPart = Int -> Text -> Text -> Text
processMany Int
metaIndent Text
"SOURCE" Text
sourceT
organismPart :: Maybe Text
organismPart = (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text -> Text
processMany Int
metaIndent (Int -> Text -> Text
prependIndent Int
metaPreIndent Text
"ORGANISM")) Maybe Text
organism
versionToText :: Version -> Text
versionToText :: Version -> Text
versionToText Version{Maybe Text
Text
gbId :: Version -> Maybe Text
versionT :: Version -> Text
gbId :: Maybe Text
versionT :: Text
..} = Int -> Text -> Text
toIndent Int
metaIndent Text
"VERSION" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
version
where
version :: Text
version = Text
versionT Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
spaces Int
5 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty (Text
"GI:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) Maybe Text
gbId
referenceToText :: Reference -> Text
referenceToText :: Reference -> Text
referenceToText Reference{Maybe Text
Text
pubmed :: Reference -> Maybe Text
journal :: Reference -> Maybe Text
title :: Reference -> Maybe Text
authors :: Reference -> Maybe Text
referenceT :: Reference -> Text
pubmed :: Maybe Text
journal :: Maybe Text
title :: Maybe Text
authors :: Maybe Text
referenceT :: Text
..} = [Text] -> Text
interNewLine ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
mainPart Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
parts
where
mainPart :: Text
mainPart = Int -> Text -> Text -> Text
processMany Int
metaIndent Text
"REFERENCE" Text
referenceT
sectionNames :: [Text]
sectionNames = (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
prependIndent Int
metaPreIndent) [Text
"AUTHORS", Text
"TITLE", Text
"JOURNAL", Text
"PUBMED"]
sections :: [Maybe Text]
sections = [Maybe Text
authors, Maybe Text
title, Maybe Text
journal, Maybe Text
pubmed]
parts :: [Text]
parts = (Text -> Maybe Text -> Text) -> [Text] -> [Maybe Text] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
a -> Maybe Text -> Text
textFromMaybe (Maybe Text -> Text)
-> (Maybe Text -> Maybe Text) -> Maybe Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text -> Text
processMany Int
metaIndent Text
a)) [Text]
sectionNames [Maybe Text]
sections
metaIndent :: Int
metaIndent :: Int
metaIndent = Int
12
metaPreIndent :: Int
metaPreIndent :: Int
metaPreIndent = Int
2
featuresToText :: [(Feature, Range)] -> Text
featuresToText :: [(Feature, Range)] -> Text
featuresToText [(Feature, Range)]
l = [Text] -> Text
interNewLine ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
mainPart Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
sections
where
mainPart :: Text
mainPart = Int -> Text -> Text -> Text
processMany Int
featuresIndent Text
"FEATURES" Text
featuresText
sections :: [Text]
sections = ((Feature, Range) -> Text) -> [(Feature, Range)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Feature, Range) -> Text
featureToText [(Feature, Range)]
l
featuresText :: Text
featuresText :: Text
featuresText = Text
"Location/Qualifiers"
featureToText :: (Feature, Range) -> Text
featureToText :: (Feature, Range) -> Text
featureToText (Feature{[(Text, Text)]
Text
fProps :: Feature -> [(Text, Text)]
fName :: Feature -> Text
fProps :: [(Text, Text)]
fName :: Text
..}, Range
range) = [Text] -> Text
interNewLine ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
mainPart Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
sections
where
mainPart :: Text
mainPart = Int -> Text -> Text -> Text
processMany Int
featuresIndent (Int -> Text -> Text
prependIndent Int
featuresPreIndent Text
fName) (Range -> Text
featureRangeToText (Range -> Text) -> Range -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Range -> Range
shiftRange Int
1 Range
range)
sections :: [Text]
sections = ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Text) -> Text
featurePropToText [(Text, Text)]
fProps
featurePropToText :: (Text, Text) -> Text
featurePropToText :: (Text, Text) -> Text
featurePropToText (Text
nameF, Text
textF) = Text
mainPart
where
mainPart :: Text
mainPart = Int -> Text -> Text -> Text
processMany Int
featuresIndent Text
forall a. Monoid a => a
mempty (Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameF Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
textF Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"")
featureRangeToText :: Range -> Text
featureRangeToText :: Range -> Text
featureRangeToText (Point Int
pos) = Int -> Text
forall a. Show a => a -> Text
showText Int
pos
featureRangeToText (Span (RangeBorder Border
rbLo Int
lo) (RangeBorder Border
rbHi Int
hi)) = Bool -> Border -> Text
borderToText Bool
True Border
rbLo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showText Int
lo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Border -> Text
borderToText Bool
False Border
rbHi Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showText Int
hi
where
borderToText :: Bool -> Border -> Text
borderToText :: Bool -> Border -> Text
borderToText Bool
_ Border
Precise = Text
""
borderToText Bool
True Border
Exceeded = Text
"<"
borderToText Bool
False Border
Exceeded = Text
">"
featureRangeToText (Between Int
lo Int
hi) = Int -> Text
forall a. Show a => a -> Text
showText Int
lo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"^" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showText Int
hi
featureRangeToText (Join [Range]
ranges) = Text
"join(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"," (Range -> Text
featureRangeToText (Range -> Text) -> [Range] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Range]
ranges) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
featureRangeToText (Complement Range
range) = Text
"complement(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Range -> Text
featureRangeToText Range
range Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
featuresIndent :: Int
featuresIndent :: Int
featuresIndent = Int
21
featuresPreIndent :: Int
featuresPreIndent :: Int
featuresPreIndent = Int
5
originToText :: Text -> Text
originToText :: Text -> Text
originToText Text
text = [Text] -> Text
interNewLine ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
mainPart Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
parts
where
mainPart :: Text
mainPart = Text
"ORIGIN"
manyLines :: [[Text]]
manyLines = Int -> [Text] -> [[Text]]
forall e. Int -> [e] -> [[e]]
S.chunksOf Int
lengthOfLineChunk ([Text] -> [[Text]]) -> [Text] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
T.chunksOf Int
lengthOfChunk Text
text
parts :: [Text]
parts = (Int -> [Text] -> Text) -> [Int] -> [[Text]] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> [Text] -> Text
processLine [Int
1, Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lengthOfChunk Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
lengthOfLineChunk..] [[Text]]
manyLines
processLine :: Int -> [Text] -> Text
processLine :: Int -> [Text] -> Text
processLine Int
startInd = [Text] -> Text
T.unwords ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Text -> Text
prependIndent (Int
originIndent Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
indText) Text
indText Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)
where
indText :: Text
indText = Int -> Text
forall a. Show a => a -> Text
showText Int
startInd
lengthOfChunk :: Int
lengthOfChunk :: Int
lengthOfChunk = Int
10
lengthOfLineChunk :: Int
lengthOfLineChunk :: Int
lengthOfLineChunk = Int
6
originIndent :: Int
originIndent :: Int
originIndent = Int
9
processMany :: Int -> Text -> Text -> Text
processMany :: Int -> Text -> Text -> Text
processMany Int
indent Text
name Text
"" = Int -> Text -> Text
toIndent Int
indent Text
name
processMany Int
indent Text
name Text
text = [Text] -> Text
interNewLine [Text]
resLines
where
(Text
x : [Text]
xs) = Text -> [Text]
T.lines Text
text
resLines :: [Text]
resLines = Int -> Text -> Text
toIndent Int
indent Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x
Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
prependIndent Int
indent) [Text]
xs
interNewLine :: [Text] -> Text
interNewLine :: [Text] -> Text
interNewLine = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)
textFromMaybe :: Maybe Text -> Text
textFromMaybe :: Maybe Text -> Text
textFromMaybe = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty
toIndent :: Int -> Text -> Text
toIndent :: Int -> Text -> Text
toIndent Int
indent Text
name = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Int -> Text
spaces (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Text -> Int
T.length Text
name))
prependIndent :: Int -> Text -> Text
prependIndent :: Int -> Text -> Text
prependIndent = Text -> Text -> Text
T.append (Text -> Text -> Text) -> (Int -> Text) -> Int -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
spaces
showText :: Show a => a -> Text
showText :: a -> Text
showText = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
spaces :: Int -> Text
spaces :: Int -> Text
spaces = String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Char -> String) -> Char -> Int -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Char -> String
forall a. Int -> a -> [a]
replicate Char
' '