{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  ELynx.Export.Nexus
-- Description :  Nexus types and classes
-- Copyright   :  (c) Dominik Schrempf 2021
-- License     :  GPL-3
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Tue Apr 28 17:10:05 2020.
module ELynx.Export.Nexus
  ( toNexus,
  )
where

import qualified Data.ByteString.Lazy.Char8 as BL

-- | Create nexus file with block name and block body.
--
-- At the moment writing one block only is supported.
toNexus :: BL.ByteString -> [BL.ByteString] -> BL.ByteString
toNexus :: ByteString -> [ByteString] -> ByteString
toNexus ByteString
n [ByteString]
b = [ByteString] -> ByteString
BL.unlines ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString
start, ByteString -> ByteString
begin ByteString
n] [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
b [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString
end]

start :: BL.ByteString
start :: ByteString
start = ByteString
"#NEXUS"

begin :: BL.ByteString -> BL.ByteString
begin :: ByteString -> ByteString
begin ByteString
n = ByteString
"BEGIN " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
n ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";"

end :: BL.ByteString
end :: ByteString
end = ByteString
"END;"