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