module Vulkan.Utils.ShaderQQ.Backend.Shaderc
( ShadercError
, ShadercWarning
, processShadercMessages
) where
import Control.Monad ( void )
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.Foldable ( asum )
import Text.ParserCombinators.ReadP
type ShadercError = String
type ShadercWarning = String
processShadercMessages :: BSL.ByteString -> ([ShadercWarning], [ShadercError])
processShadercMessages :: ByteString -> ([ShadercWarning], [ShadercWarning])
processShadercMessages = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ShadercWarning -> ([ShadercWarning], [ShadercWarning])
parseMsg forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShadercWarning -> [ShadercWarning]
lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShadercWarning
BSL.unpack
parseMsg :: String -> ([ShadercWarning], [ShadercError])
parseMsg :: ShadercWarning -> ([ShadercWarning], [ShadercWarning])
parseMsg = forall p. Monoid p => ReadP p -> ShadercWarning -> p
runParser forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1
forall a. ReadP a -> ReadP a -> ReadP a
(<++)
[ do
ShadercWarning
f <- ReadP ShadercWarning
filename
Integer
line <- forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
between ReadP ()
colon ReadP ()
colon ReadP Integer
number
ReadP ()
skipSpaces
ShadercWarning -> ([ShadercWarning], [ShadercWarning])
t <- forall {a}. ReadP (a -> ([a], [a]))
msgType
ShadercWarning
msg <- forall a end. ReadP a -> ReadP end -> ReadP [a]
manyTill ReadP Char
get ReadP ()
eof
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {a} {t}.
Show a =>
(ShadercWarning -> t) -> ShadercWarning -> a -> ShadercWarning -> t
formatMsg ShadercWarning -> ([ShadercWarning], [ShadercWarning])
t ShadercWarning
f Integer
line ShadercWarning
msg
, do
ShadercWarning
f <- ReadP ShadercWarning
filename
ReadP ()
colon forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadP ()
skipSpaces
ShadercWarning -> ([ShadercWarning], [ShadercWarning])
t <- forall {a}. ReadP (a -> ([a], [a]))
msgType
ShadercWarning
_ <- ShadercWarning -> ReadP ShadercWarning
string ShadercWarning
f
Integer
line <- forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
between (Char -> ReadP Char
char Char
':') (Char -> ReadP Char
char Char
':') ReadP Integer
number
ReadP ()
skipSpaces
ShadercWarning
msg <- forall a end. ReadP a -> ReadP end -> ReadP [a]
manyTill ReadP Char
get ReadP ()
eof
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {a} {t}.
Show a =>
(ShadercWarning -> t) -> ShadercWarning -> a -> ShadercWarning -> t
formatMsg ShadercWarning -> ([ShadercWarning], [ShadercWarning])
t ShadercWarning
f Integer
line ShadercWarning
msg
, do
ShadercWarning
f <- ReadP ShadercWarning
filename
ReadP ()
colon forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadP ()
skipSpaces
ShadercWarning
_ <- ShadercWarning -> ReadP ShadercWarning
string ShadercWarning
f
Integer
line <- forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
between (Char -> ReadP Char
char Char
'(') (Char -> ReadP Char
char Char
')') ReadP Integer
number
ReadP ()
colon forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadP ()
skipSpaces
let t :: a -> ([a], [a])
t a
x = ([], [a
x])
ShadercWarning
msg <- forall a end. ReadP a -> ReadP end -> ReadP [a]
manyTill ReadP Char
get ReadP ()
eof
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {a} {t}.
Show a =>
(ShadercWarning -> t) -> ShadercWarning -> a -> ShadercWarning -> t
formatMsg forall {a} {a}. a -> ([a], [a])
t ShadercWarning
f Integer
line ShadercWarning
msg
, do
Integer
_ <- ReadP Integer
number
ReadP ()
skipSpaces
ShadercWarning
_ <- ShadercWarning -> ReadP ShadercWarning
string ShadercWarning
"errors generated"
ReadP ()
eof
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
, do
ShadercWarning
msg <- forall a end. ReadP a -> ReadP end -> ReadP [a]
manyTill ReadP Char
get ReadP ()
eof
ReadP ()
eof
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [ShadercWarning
msg])
]
where
formatMsg :: (ShadercWarning -> t) -> ShadercWarning -> a -> ShadercWarning -> t
formatMsg ShadercWarning -> t
t ShadercWarning
f a
line ShadercWarning
msg = ShadercWarning -> t
t (ShadercWarning
f forall a. Semigroup a => a -> a -> a
<> ShadercWarning
":" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> ShadercWarning
show a
line forall a. Semigroup a => a -> a -> a
<> ShadercWarning
": " forall a. Semigroup a => a -> a -> a
<> ShadercWarning
msg)
filename :: ReadP ShadercWarning
filename = forall a. ReadP a -> ReadP [a]
many1 ReadP Char
get
number :: ReadP Integer
number = forall a. ReadS a -> ReadP a
readS_to_P (forall a. Read a => ReadS a
reads @Integer)
colon :: ReadP ()
colon = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
char Char
':'
msgType :: ReadP (a -> ([a], [a]))
msgType =
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
[ (\a
x -> ([], [a
x])) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ShadercWarning -> ReadP ShadercWarning
string ShadercWarning
"error"
, (\a
x -> ([a
x], [])) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ShadercWarning -> ReadP ShadercWarning
string ShadercWarning
"warning"
]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP ()
colon
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP ()
skipSpaces
runParser :: Monoid p => ReadP p -> String -> p
runParser :: forall p. Monoid p => ReadP p -> ShadercWarning -> p
runParser ReadP p
p ShadercWarning
s = case forall a. ReadP a -> ReadS a
readP_to_S ReadP p
p ShadercWarning
s of
[(p
r, ShadercWarning
"")] -> p
r
[(p, ShadercWarning)]
_ -> forall a. Monoid a => a
mempty