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 :: forall (m :: * -> *).
(Applicative m, Monad m) =>
String
-> (String -> m ())
-> (String -> m ByteString)
-> ([String], Either [String] ByteString)
-> m ByteString
messageProcess String
tool String -> m ()
warn String -> m ByteString
err ([String]
warnings, Either [String] ByteString
result) = do
  case [String]
warnings of
    []    -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    [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]
++ String
" failed with no errors"
    Left [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 ByteString
bs -> ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs
  where
    prepare :: [String] -> String
prepare [String
singleLine] = String
singleLine
    prepare [String]
multiline =
      String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\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] -> [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
"        ") [String]
multiline