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
"//"
            ]

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

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

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

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
")"

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

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