bytepatch-0.2.1: app/Main.hs

{-# LANGUAGE ScopedTypeVariables #-}

module Main ( main ) where

import           Config
import qualified Options

import           BytePatch.Pretty
import           BytePatch.Pretty.PatchRep
import           BytePatch.JSON()
import qualified BytePatch.Linear.Patch     as Linear
import qualified BytePatch.Linear.Gen       as Linear

import           Control.Monad.IO.Class
import qualified Data.ByteString            as BS
import qualified Data.ByteString.Lazy       as BL
import qualified Data.Yaml                  as Yaml
import           Data.Aeson                 ( FromJSON )

import           Data.Text                  ( Text )
import           BytePatch.Pretty.HexByteString

main :: IO ()
main = Options.parse >>= run

run :: MonadIO m => Config -> m ()
run cfg = do
    return ()
    tryReadPatchscript @HexByteString (cfgPatchscript cfg) >>= \case
      Nothing -> quit "couldn't parse patchscript"
      Just ps ->
        case normalizeSimple ps of
          Nothing -> quit "failed while normalizing patchscript"
          Just p  ->
            case Linear.gen p of
              (_, genErrs@(_:_)) -> quit' "patchscript generation failed" genErrs
              (ps', []) -> do
                bs <- readStream' io
                case Linear.patchPure (cfgPatchCfg cfg) ps' bs of
                  Left patchErr -> quit' "patching failed" patchErr
                  Right bs' -> writeStream' io (BL.toStrict bs')
  where
    io = cfgStreamInOut cfg

readStream :: MonadIO m => CStream -> m BS.ByteString
readStream stream = liftIO $
    case stream of
      CStreamStd     -> BS.getContents
      CStreamFile fp -> BS.readFile fp

readStream' :: MonadIO m => CStreamInOut -> m BS.ByteString
readStream' = readStream . fst . unCStreamInOut

writeStream :: MonadIO m => CStream -> BS.ByteString -> m ()
writeStream stream bs = liftIO $
    case stream of
      CStreamStd     -> BS.putStr bs
      CStreamFile fp -> BS.writeFile fp bs

writeStream' :: MonadIO m => CStreamInOut -> BS.ByteString -> m ()
writeStream' stream = writeStream (snd (unCStreamInOut stream))

quit' :: (MonadIO m, Show a) => String -> a -> m ()
quit' msg a = liftIO $ do
    putStrLn $ "bytepatch: error: " <> msg
    print a

quit :: MonadIO m => String -> m ()
quit = liftIO . putStrLn

tryReadPatchscript :: forall a m. (PatchRep a, FromJSON a, MonadIO m) => FilePath -> m (Maybe [CommonMultiEdits a])
tryReadPatchscript = tryDecodeYaml

tryDecodeYaml :: (FromJSON a, MonadIO m) => FilePath -> m (Maybe a)
tryDecodeYaml fp = do
    bs <- liftIO $ BS.readFile fp
    case Yaml.decodeEither' bs of
      Left  _      -> return Nothing
      Right parsed -> return $ Just parsed