EncodeFiles.hs

{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}

module App.Commands.EncodeFiles where

import App.Commands.Options.Type
import Arbor.File.Format.Asif.ByteString.Builder
import Arbor.File.Format.Asif.IO
import Conduit
import Control.Lens
import Control.Monad
import Control.Monad.IO.Class                    (liftIO)
import Control.Monad.Trans.Resource              (MonadResource, runResourceT)
import Data.Generics.Product.Any
import Data.Monoid
import Options.Applicative

import qualified Data.ByteString     as BS
import qualified Data.Conduit        as C
import qualified Data.Conduit.Binary as C
import qualified Data.Text           as T
import qualified Data.Text.Encoding  as T
import qualified System.IO           as IO

parseEncodeFilesOptions :: Parser EncodeFilesOptions
parseEncodeFilesOptions = EncodeFilesOptions
  <$> strOption
      (   long "source"
      <>  metavar "FILE"
      <>  help "Input file"
      )
  <*> strOption
      (   long "target"
      <>  metavar "FILE"
      <>  value "-"
      <>  help "Output file"
      )
  <*> strOption
      (   long "asif-type"
      <>  metavar "ASIF_TYPE"
      <>  help "The magic extension of the asif file"
      )

commandEncodeFiles :: Parser (IO ())
commandEncodeFiles = runResourceT . runEncodeFiles <$> parseEncodeFilesOptions

runEncodeFiles :: MonadResource m => EncodeFilesOptions -> m ()
runEncodeFiles opt = do
  let sourcePath = opt ^. the @"source"
  filenamesContents <- liftIO $ BS.readFile (sourcePath <> "/.asif/filenames")
  let filenames = mfilter (/= "") $ T.decodeUtf8 <$> BS.split 0 filenamesContents

  handles <- forM filenames $ \filename -> do
    h <- liftIO $ IO.openFile (sourcePath <> "/" <> T.unpack filename) IO.ReadWriteMode
    liftIO $ IO.hSeek h IO.SeekFromEnd 0
    return h

  let contents = segmentsRawC (opt ^. the @"asifType") handles

  (_, hTarget) <- openFileOrStd (opt ^. the @"target") IO.WriteMode

  C.runConduit $ contents .| C.sinkHandle hTarget

  liftIO $ IO.hFlush hTarget