{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

{-|
Description : Example showing how to add a comment to an existing AB1 file
Copyright   : (c) HyraxBio, 2018
License     : BSD3
Maintainer  : andre@hyraxbio.co.za, andre@andrevdm.com

Example showing how to add a comment to an existing AB1 file.
See other examples in "Examples"
-}
module Examples.AddComment where

import           Protolude

import qualified Hyrax.Abif.Read as H
import qualified Hyrax.Abif.Write as H

-- | Add a comment to an existing AB1 file
addComment :: IO ()
addComment :: IO ()
addComment = do
  Either Text Abif
abif' <- FilePath -> IO (Either Text Abif)
H.readAbif FilePath
"example.ab1"

  case Either Text Abif
abif' of
    Left Text
e -> Text -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"error reading ABIF: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e
    Right Abif
abif -> do
      let modified :: Abif
modified = Abif -> Directory -> Abif
H.addDirectory Abif
abif (Directory -> Abif) -> Directory -> Abif
forall a b. (a -> b) -> a -> b
$ Text -> Directory
H.mkComment Text
"new comment"
      FilePath -> Abif -> IO ()
H.writeAbif FilePath
"example.modified.ab1" Abif
modified