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 -> ([String], [String])
processShadercMessages = (String -> ([String], [String]))
-> [String] -> ([String], [String])
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap String -> ([String], [String])
parseMsg ([String] -> ([String], [String]))
-> (ByteString -> [String]) -> ByteString -> ([String], [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String])
-> (ByteString -> String) -> ByteString -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BSL.unpack

-- >>> parseMsg "blah"
-- ([],[])
--
-- >>> parseMsg "blah"
-- ([],["blah"])
--
-- >>> parseMsg "foo:2: error: unknown var"
-- ([],["foo:2: unknown var"])
--
-- >>> parseMsg "foo:2: warning: unknown var"
-- (["foo:2: unknown var"],[])
--
-- >>> parseMsg "bar:2: error: 'a' : unknown variable"
-- ([],["bar:2: 'a' : unknown variable"])
--
-- >>> parseMsg "f:o: error: f:o:2: 'a' : unknown variable"
-- ([],["f:o:2: 'a' : unknown variable"])
--
-- >>> parseMsg "f:o: error: f:o:2: 'return' : type does not match, or is not convertible to, the function's return type"
-- ([],["f:o:2: 'return' : type does not match, or is not convertible to, the function's return type"])
--
-- >>> parseMsg "foo: foo(1): error at column 3, HLSL parsing failed."
-- ([],["foo:1: error at column 3, HLSL parsing failed."])
parseMsg :: String -> ([ShadercWarning], [ShadercError])
parseMsg :: String -> ([String], [String])
parseMsg = ReadP ([String], [String]) -> String -> ([String], [String])
forall p. Monoid p => ReadP p -> String -> p
runParser (ReadP ([String], [String]) -> String -> ([String], [String]))
-> ReadP ([String], [String]) -> String -> ([String], [String])
forall a b. (a -> b) -> a -> b
$ (ReadP ([String], [String])
 -> ReadP ([String], [String]) -> ReadP ([String], [String]))
-> [ReadP ([String], [String])] -> ReadP ([String], [String])
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1
  ReadP ([String], [String])
-> ReadP ([String], [String]) -> ReadP ([String], [String])
forall a. ReadP a -> ReadP a -> ReadP a
(<++)
  [ do
    String
f    <- ReadP String
filename
    Integer
line <- ReadP () -> ReadP () -> ReadP Integer -> ReadP Integer
forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
between ReadP ()
colon ReadP ()
colon ReadP Integer
number
    ReadP ()
skipSpaces
    String -> ([String], [String])
t   <- ReadP (String -> ([String], [String]))
forall {a}. ReadP (a -> ([a], [a]))
msgType
    String
msg <- ReadP Char -> ReadP () -> ReadP String
forall a end. ReadP a -> ReadP end -> ReadP [a]
manyTill ReadP Char
get ReadP ()
eof
    ([String], [String]) -> ReadP ([String], [String])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([String], [String]) -> ReadP ([String], [String]))
-> ([String], [String]) -> ReadP ([String], [String])
forall a b. (a -> b) -> a -> b
$ (String -> ([String], [String]))
-> String -> Integer -> String -> ([String], [String])
forall {a} {t}.
Show a =>
(String -> t) -> String -> a -> String -> t
formatMsg String -> ([String], [String])
t String
f Integer
line String
msg
  , do
    String
f <- ReadP String
filename
    ReadP ()
colon ReadP () -> ReadP () -> ReadP ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadP ()
skipSpaces
    String -> ([String], [String])
t    <- ReadP (String -> ([String], [String]))
forall {a}. ReadP (a -> ([a], [a]))
msgType
    String
_    <- String -> ReadP String
string String
f
    Integer
line <- ReadP Char -> ReadP Char -> ReadP Integer -> ReadP Integer
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
    String
msg <- ReadP Char -> ReadP () -> ReadP String
forall a end. ReadP a -> ReadP end -> ReadP [a]
manyTill ReadP Char
get ReadP ()
eof
    ([String], [String]) -> ReadP ([String], [String])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([String], [String]) -> ReadP ([String], [String]))
-> ([String], [String]) -> ReadP ([String], [String])
forall a b. (a -> b) -> a -> b
$ (String -> ([String], [String]))
-> String -> Integer -> String -> ([String], [String])
forall {a} {t}.
Show a =>
(String -> t) -> String -> a -> String -> t
formatMsg String -> ([String], [String])
t String
f Integer
line String
msg
  , do
    String
f <- ReadP String
filename
    ReadP ()
colon ReadP () -> ReadP () -> ReadP ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadP ()
skipSpaces
    String
_    <- String -> ReadP String
string String
f
    Integer
line <- ReadP Char -> ReadP Char -> ReadP Integer -> ReadP Integer
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 ReadP () -> ReadP () -> ReadP ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadP ()
skipSpaces
    let t :: a -> ([a], [a])
t a
x = ([], [a
x])
    String
msg <- ReadP Char -> ReadP () -> ReadP String
forall a end. ReadP a -> ReadP end -> ReadP [a]
manyTill ReadP Char
get ReadP ()
eof
    ([String], [String]) -> ReadP ([String], [String])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([String], [String]) -> ReadP ([String], [String]))
-> ([String], [String]) -> ReadP ([String], [String])
forall a b. (a -> b) -> a -> b
$ (String -> ([String], [String]))
-> String -> Integer -> String -> ([String], [String])
forall {a} {t}.
Show a =>
(String -> t) -> String -> a -> String -> t
formatMsg String -> ([String], [String])
forall {a} {a}. a -> ([a], [a])
t String
f Integer
line String
msg
  , do
    Integer
_ <- ReadP Integer
number
    ReadP ()
skipSpaces
    String
_ <- String -> ReadP String
string String
"errors generated"
    ReadP ()
eof
    ([String], [String]) -> ReadP ([String], [String])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
  , do
    -- Unknown format
    String
msg <- ReadP Char -> ReadP () -> ReadP String
forall a end. ReadP a -> ReadP end -> ReadP [a]
manyTill ReadP Char
get ReadP ()
eof
    ReadP ()
eof
    ([String], [String]) -> ReadP ([String], [String])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [String
msg])
  ]
 where
  formatMsg :: (String -> t) -> String -> a -> String -> t
formatMsg String -> t
t String
f a
line String
msg = String -> t
t (String
f String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
":" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
line String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msg)
  filename :: ReadP String
filename = ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
many1 ReadP Char
get
  number :: ReadP Integer
number   = ReadS Integer -> ReadP Integer
forall a. ReadS a -> ReadP a
readS_to_P (forall a. Read a => ReadS a
reads @Integer)
  colon :: ReadP ()
colon    = ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP Char -> ReadP ()) -> ReadP Char -> ReadP ()
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
char Char
':'
  msgType :: ReadP (a -> ([a], [a]))
msgType =
    [ReadP (a -> ([a], [a]))] -> ReadP (a -> ([a], [a]))
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        [ (\a
x -> ([], [a
x])) (a -> ([a], [a])) -> ReadP String -> ReadP (a -> ([a], [a]))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string String
"error"
        , (\a
x -> ([a
x], [])) (a -> ([a], [a])) -> ReadP String -> ReadP (a -> ([a], [a]))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string String
"warning"
        ]
      ReadP (a -> ([a], [a])) -> ReadP () -> ReadP (a -> ([a], [a]))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP ()
colon
      ReadP (a -> ([a], [a])) -> ReadP () -> ReadP (a -> ([a], [a]))
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 -> String -> p
runParser ReadP p
p String
s = case ReadP p -> ReadS p
forall a. ReadP a -> ReadS a
readP_to_S ReadP p
p String
s of
  [(p
r, String
"")] -> p
r
  [(p, String)]
_         -> p
forall a. Monoid a => a
mempty