module Vulkan.Utils.ShaderQQ.Backend.Internal
  ( messageProcess
  ) where

import           Data.ByteString                ( ByteString )
import           Data.List.Extra

messageProcess
  :: (Applicative m, Monad m)
  => String
  -- ^ tool name
  -> (String -> m ())
  -- ^ warning
  -> (String -> m ByteString)
  -- ^ error
  -> ([String], Either [String] ByteString)
  -- ^ Spir-V bytecode with warnings or errors
  -> m ByteString
  -- ^ Spir-V bytecode
messageProcess :: String
-> (String -> m ())
-> (String -> m ByteString)
-> ([String], Either [String] ByteString)
-> m ByteString
messageProcess tool :: String
tool warn :: String -> m ()
warn err :: String -> m ByteString
err (warnings :: [String]
warnings, result :: Either [String] ByteString
result) = do
  case [String]
warnings of
    []    -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    _some :: [String]
_some -> String -> m ()
warn (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
prepare [String]
warnings
  case Either [String] ByteString
result of
    Left []     -> String -> m ByteString
err (String -> m ByteString) -> String -> m ByteString
forall a b. (a -> b) -> a -> b
$ String
tool String -> String -> String
forall a. [a] -> [a] -> [a]
++ " failed with no errors"
    Left errors :: [String]
errors -> do
      ByteString
_ <- String -> m ByteString
err (String -> m ByteString) -> String -> m ByteString
forall a b. (a -> b) -> a -> b
$ [String] -> String
prepare [String]
errors
      ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
forall a. Monoid a => a
mempty
    Right bs :: ByteString
bs -> ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs
  where
    prepare :: [String] -> String
prepare [singleLine :: String
singleLine] = String
singleLine
    prepare multiline :: [String]
multiline =
      String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String
tool String -> String -> String
forall a. [a] -> [a] -> [a]
++ ":") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
forall a. Monoid a => a -> a -> a
mappend "        ") [String]
multiline