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

--------------------------------------------------------------------------------
-- 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{[(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
")"

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