ExtractSegments.hs

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

module App.Commands.ExtractSegments where

import App.Commands.Options.Type      (ExtractSegmentsOptions (ExtractSegmentsOptions))
import Arbor.File.Format.Asif.IO
import Arbor.File.Format.Asif.Segment
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 System.Directory
import Text.Printf

import qualified Data.Attoparsec.ByteString as AP
import qualified Data.ByteString            as BS
import qualified Data.ByteString.Lazy       as LBS
import qualified System.IO                  as IO

parseExtractSegmentsOptions :: Parser ExtractSegmentsOptions
parseExtractSegmentsOptions = ExtractSegmentsOptions
  <$> strOption
      (   long "source"
      <>  metavar "FILE"
      <>  value "-"
      <>  help "Input file"
      )
  <*> strOption
      (   long "target"
      <>  metavar "PATH"
      <>  help "Output directory"
      )

commandExtractSegments :: Parser (IO ())
commandExtractSegments = runResourceT . runExtractSegments <$> parseExtractSegmentsOptions

runExtractSegments :: MonadResource m => ExtractSegmentsOptions -> m ()
runExtractSegments opt = do
  (_, hIn) <- openFileOrStd (opt ^. the @"source") IO.ReadMode
  contents <- liftIO $ LBS.hGetContents hIn
  -- TODO pass in magic
  case extractSegments magic contents of
    Left errorMessage -> do
      liftIO $ IO.hPutStrLn IO.stderr $ "Error occured: " <> errorMessage
      return ()
    Right segments -> do
      let targetPath = opt ^. the @"target"

      liftIO $ IO.hPutStrLn IO.stderr $ "Writing to: " <> targetPath

      liftIO $ createDirectoryIfMissing True targetPath

      forM_ (zip [0..] segments) $ \(i :: Int, segment) ->
        liftIO $ LBS.writeFile (targetPath <> "/" <> printf "%03d" i <> ".seg") (segment ^. the @"payload")
  where magic = AP.string "seg:" *> (BS.pack <$> many AP.anyWord8) AP.<?> "\"seg:????\""