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 forall a. Semigroup a => a -> a -> a
<> Text
"\n"
where
parts :: [Text]
parts = [ Meta -> Text
metaToText Meta
meta
, [(Feature, Range)] -> Text
featuresToText forall a b. (a -> b) -> a -> b
$ MarkedSequence Feature Char
gbSeq forall s a. s -> Getting a s a -> a
^. forall mk w a. Getter (Sequence mk w a) [(mk, Range)]
markings
, Text -> Text
originToText forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> Text
versionToText Maybe Version
version
, Maybe Text -> Text
textFromMaybe forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Source -> Text
sourceToText Maybe Source
source
]
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Reference -> Text
referenceToText [Reference]
references
forall a. Semigroup a => a -> a -> a
<> 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" forall a. Semigroup a => a -> a -> a
<> Text
locusText
where
locusList :: [Text]
locusList = [ Text
name
, forall a. Show a => a -> Text
showText Int
len forall a. Semigroup a => a -> a -> a
<> Text
" bp"
, Text
molType
, Maybe Text -> Text
textFromMaybe forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text
T.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not 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 forall a b. (a -> b) -> a -> b
$ Text
mainPart forall a. a -> [a] -> [a]
: 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 = 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" forall a. Semigroup a => a -> a -> a
<> Text
version
where
version :: Text
version = Text
versionT forall a. Semigroup a => a -> a -> a
<> Int -> Text
spaces Int
5 forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (Text
"GI:" 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 forall a b. (a -> b) -> a -> b
$ Text
mainPart 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 = 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 = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
a -> Maybe Text -> Text
textFromMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$ Text
mainPart 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 = 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 forall a b. (a -> b) -> a -> b
$ Text
mainPart 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 forall a b. (a -> b) -> a -> b
$ Int -> Range -> Range
shiftRange Int
1 Range
range)
sections :: [Text]
sections = 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 forall a. Monoid a => a
mempty (Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
nameF forall a. Semigroup a => a -> a -> a
<> Text
"=\"" forall a. Semigroup a => a -> a -> a
<> Text
textF forall a. Semigroup a => a -> a -> a
<> Text
"\"")
featureRangeToText :: Range -> Text
featureRangeToText :: Range -> Text
featureRangeToText (Point Int
pos) = 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 forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showText Int
lo forall a. Semigroup a => a -> a -> a
<> Text
".." forall a. Semigroup a => a -> a -> a
<> Bool -> Border -> Text
borderToText Bool
False Border
rbHi forall a. Semigroup a => a -> a -> a
<> 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) = forall a. Show a => a -> Text
showText Int
lo forall a. Semigroup a => a -> a -> a
<> Text
"^" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showText Int
hi
featureRangeToText (Join [Range]
ranges) = Text
"join(" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"," (Range -> Text
featureRangeToText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Range]
ranges) forall a. Semigroup a => a -> a -> a
<> Text
")"
featureRangeToText (Complement Range
range) = Text
"complement(" forall a. Semigroup a => a -> a -> a
<> Range -> Text
featureRangeToText Range
range 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 forall a b. (a -> b) -> a -> b
$ Text
mainPart forall a. a -> [a] -> [a]
: [Text]
parts
where
mainPart :: Text
mainPart = Text
"ORIGIN"
manyLines :: [[Text]]
manyLines = forall e. Int -> [e] -> [[e]]
S.chunksOf Int
lengthOfLineChunk forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
T.chunksOf Int
lengthOfChunk Text
text
parts :: [Text]
parts = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> [Text] -> Text
processLine [Int
1, Int
1 forall a. Num a => a -> a -> a
+ Int
lengthOfChunk 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Text -> Text
prependIndent (Int
originIndent forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
indText) Text
indText forall a. a -> [a] -> [a]
:)
where
indText :: Text
indText = 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
text =
case Text -> [Text]
T.lines Text
text of
[] -> Int -> Text -> Text
toIndent Int
indent Text
name
(Text
x:[Text]
xs) ->
let
resLines :: [Text]
resLines = Int -> Text -> Text
toIndent Int
indent Text
name forall a. Semigroup a => a -> a -> a
<> Text
x
forall a. a -> [a] -> [a]
: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
prependIndent Int
indent) [Text]
xs
in [Text] -> Text
interNewLine [Text]
resLines
interNewLine :: [Text] -> Text
interNewLine :: [Text] -> Text
interNewLine = Text -> [Text] -> Text
T.intercalate Text
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)
textFromMaybe :: Maybe Text -> Text
textFromMaybe :: Maybe Text -> Text
textFromMaybe = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty
toIndent :: Int -> Text -> Text
toIndent :: Int -> Text -> Text
toIndent Int
indent Text
name = Text
name forall a. Semigroup a => a -> a -> a
<> Int -> Text
spaces (Int
indent 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
spaces
showText :: Show a => a -> Text
showText :: forall a. Show a => a -> Text
showText = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
spaces :: Int -> Text
spaces :: Int -> Text
spaces = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Int -> a -> [a]
replicate Char
' '