module Vulkan.Utils.ShaderQQ.Backend.Internal
( messageProcess
) where
import Data.ByteString ( ByteString )
import Data.List.Extra
messageProcess
:: (Applicative m, Monad m)
=> String
-> (String -> m ())
-> (String -> m ByteString)
-> ([String], Either [String] ByteString)
-> m ByteString
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