module Bio.GB.Writer
  ( genBankToText
  ) where

import           Bio.GB.Type     (Feature (..), GenBankSequence (..),
                                  Locus (..), Meta (..), Reference (..),
                                  Source (..), Version (..))
import           Bio.Sequence    (Range, markings, 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
"//"
            ]

--------------------------------------------------------------------------------
-- Block with meta-information.
--------------------------------------------------------------------------------

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

-- | Indentation of data in section with metainformation.
--
metaIndent :: Int
metaIndent :: Int
metaIndent = Int
12

-- | Indentation in subsections of section with meta-information.
--
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"

--------------------------------------------------------------------------------
-- Block with FEATURES section.
--------------------------------------------------------------------------------

featureToText :: (Feature, Range) -> Text
featureToText :: (Feature, Range) -> Text
featureToText (Feature{Bool
[(Text, Text)]
Text
fProps :: Feature -> [(Text, Text)]
fStrand53 :: Feature -> Bool
fName :: Feature -> Text
fProps :: [(Text, Text)]
fStrand53 :: Bool
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) (Bool -> Range -> Text
featureRangeToText Bool
fStrand53 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 :: Bool -> Range -> Text
featureRangeToText :: Bool -> Range -> Text
featureRangeToText Bool
complement (Int
l, Int
r) | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 = Bool -> Text -> Text
processComplement Bool
complement (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
showText (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                                     | Bool
otherwise  = Bool -> Text -> Text
processComplement Bool
complement (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
showText (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) 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
r
  where
    processComplement :: Bool -> Text -> Text
    processComplement :: Bool -> Text -> Text
processComplement Bool
True  Text
text = Text
text
    processComplement Bool
False Text
text = Text
"complement(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

-- | Indentation of feature's properties in FEATURES section.
--
featuresIndent :: Int
featuresIndent :: Int
featuresIndent = Int
21

-- | Indentation in subsections of FEATURES section.
--
featuresPreIndent :: Int
featuresPreIndent :: Int
featuresPreIndent = Int
5

--------------------------------------------------------------------------------
-- Block with ORIGIN table.
--------------------------------------------------------------------------------

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

    -- | Number of nucleotides in one chunk.
    --
    lengthOfChunk :: Int
    lengthOfChunk :: Int
lengthOfChunk = Int
10

    -- | Number of chunks per line of sequence in ORIGIN section.
    --
    lengthOfLineChunk :: Int
    lengthOfLineChunk :: Int
lengthOfLineChunk = Int
6

-- | Indentation of new line of sequence in ORIGIN section.
--
originIndent :: Int
originIndent :: Int
originIndent = Int
9

--------------------------------------------------------------------------------
-- Utility functions.
--------------------------------------------------------------------------------

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
' '