module Bio.GB
  ( module T
  , fromFile
  , toFile
  , fromText
  , toText
  , genBankP
  ) where

import           Bio.GB.Parser
import           Bio.GB.Type            as T
import           Bio.GB.Writer          (genBankToText)
import           Control.Monad.IO.Class (MonadIO, liftIO)
import           Data.Bifunctor         (first)
import           Data.Text              (Text, pack)
import qualified Data.Text.IO           as TIO (readFile, writeFile)
import           Text.Megaparsec        (eof, errorBundlePretty, parse)

-- | Reads 'GenBankSequence' from givem file.
--
fromFile :: (MonadFail m, MonadIO m) => FilePath -> m GenBankSequence
fromFile :: FilePath -> m GenBankSequence
fromFile FilePath
f = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
TIO.readFile FilePath
f) m Text -> (Text -> m GenBankSequence) -> m GenBankSequence
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ParseErrorBundle Text Void -> m GenBankSequence)
-> (GenBankSequence -> m GenBankSequence)
-> Either (ParseErrorBundle Text Void) GenBankSequence
-> m GenBankSequence
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> m GenBankSequence
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> m GenBankSequence)
-> (ParseErrorBundle Text Void -> FilePath)
-> ParseErrorBundle Text Void
-> m GenBankSequence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> FilePath
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorBundlePretty) GenBankSequence -> m GenBankSequence
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (ParseErrorBundle Text Void) GenBankSequence
 -> m GenBankSequence)
-> (Text -> Either (ParseErrorBundle Text Void) GenBankSequence)
-> Text
-> m GenBankSequence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text GenBankSequence
-> FilePath
-> Text
-> Either (ParseErrorBundle Text Void) GenBankSequence
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
parse (Parsec Void Text GenBankSequence
genBankP Parsec Void Text GenBankSequence
-> ParsecT Void Text Identity ()
-> Parsec Void Text GenBankSequence
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) FilePath
""

-- | Writes 'GenBankSequence' to file.
--
toFile :: MonadIO m => GenBankSequence -> FilePath -> m ()
toFile :: GenBankSequence -> FilePath -> m ()
toFile GenBankSequence
s FilePath
f = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
TIO.writeFile FilePath
f (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ GenBankSequence -> Text
genBankToText GenBankSequence
s

-- | Reads 'GenBankSequence' from 'Text'.
--
fromText :: Text -> Either Text GenBankSequence
fromText :: Text -> Either Text GenBankSequence
fromText = (ParseErrorBundle Text Void -> Text)
-> Either (ParseErrorBundle Text Void) GenBankSequence
-> Either Text GenBankSequence
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FilePath -> Text
pack (FilePath -> Text)
-> (ParseErrorBundle Text Void -> FilePath)
-> ParseErrorBundle Text Void
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> FilePath
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorBundlePretty) (Either (ParseErrorBundle Text Void) GenBankSequence
 -> Either Text GenBankSequence)
-> (Text -> Either (ParseErrorBundle Text Void) GenBankSequence)
-> Text
-> Either Text GenBankSequence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text GenBankSequence
-> FilePath
-> Text
-> Either (ParseErrorBundle Text Void) GenBankSequence
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
parse (Parsec Void Text GenBankSequence
genBankP Parsec Void Text GenBankSequence
-> ParsecT Void Text Identity ()
-> Parsec Void Text GenBankSequence
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) FilePath
""

-- | Writes 'GenBankSequence' to 'Text'.
--
toText :: GenBankSequence -> Text
toText :: GenBankSequence -> Text
toText = GenBankSequence -> Text
genBankToText