content: -- MIT License, Copyright (c) 2024 Marvin Borner
  -- BLoC format is used in combination with BLoCade the BLoC-aid.
  module Target
    ( toTarget
    ) where
  
  import           Control.Exception
  import qualified Data.BitString                as Bit
  import qualified Data.ByteString.Lazy.Char8    as Byte
  import           System.IO
  import           System.Process
  
  import           Binary
  import           Config
  import           Error
  import           Helper
  
  tryIO :: IO a -> IO (Either IOException a)
  tryIO = try
  
  compile :: Expression -> String -> IO (Failable String)
  compile e target = do
    res <- tryIO $ createProcess
      (shell $ "bloc -v -i - --from-blc | blocade -v -i - -t " <> target)
        { std_in  = CreatePipe
        , std_out = CreatePipe
        }
    case res of
      Right (Just inH, Just outH, _, _) -> do
        let binary = toBinary e
        hSetBuffering inH  NoBuffering
        hSetBuffering outH NoBuffering
        hSetBinaryMode outH True
        hIsOpen inH >>= print
        hIsWritable inH >>= print
        putStrLn "sending binary"
        hPutStrLn inH binary
        hPutStr inH "\0"
        hFlush inH
        content <- hGetContents' outH
        hClose outH
        hClose inH
        return $ case content of
          "" -> Left $ OptimizerError "blocade returned empty string"
          _  -> Right content
      _ -> return $ Left $ OptimizerError "can't read from blocade"
  
  -- TODO: add more targets (including other PL compilation)
  toExpression :: String -> String -> Expression
  toExpression "blc"   = fromBinary
  toExpression "unblc" = fromBinary
  toExpression "bblc" =
    fromBinary . fromBitString . Bit.bitStringLazy . Byte.pack
  toExpression "unbblc" =
    fromBinary . fromBitString . Bit.bitStringLazy . Byte.pack
  toExpression _ = invalidProgramState
  
  toTarget :: EvalConf -> Expression -> IO Expression
  toTarget conf e = do
    let target = _toTarget conf
    case target of
      "" -> return e -- No target, fallback to unoptimized expression
      _  -> do
        maybeRes <- compile e target
        case maybeRes of
          Left err -> do
            print err
            return e -- Fallback to unoptimized expression
          Right res -> return $ toExpression target res
  