{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData        #-}
module Language.GLSL.Optimizer where

import           Control.Monad                    (when)
import           Data.Attoparsec.ByteString.Char8 (Parser)
import qualified Data.Text.Lazy                   as LT
import qualified Data.Text.Lazy.IO                as IO
import           Language.GLSL.AST                (Annot, GLSL)
import qualified Language.GLSL.Optimizer.Deinline as Deinline
import qualified Language.GLSL.Optimizer.Liveness as Liveness
import           Language.GLSL.Parser             (parseGLSL, parseShader,
                                                   parseTest)
import           Language.GLSL.PrettyPrint        (printShader)


optimizeShader :: LT.Text -> Either String LT.Text
-- optimizeShader = fmap printShader . parse
optimizeShader :: Text -> Either String Text
optimizeShader = (GLSL () -> Text) -> Either String (GLSL ()) -> Either String Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GLSL () -> Text
forall a. Annot a => GLSL a -> Text
printShader (GLSL () -> Text) -> (GLSL () -> GLSL ()) -> GLSL () -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLSL () -> GLSL ()
forall a. Annot a => GLSL a -> GLSL a
optimize) (Either String (GLSL ()) -> Either String Text)
-> (Text -> Either String (GLSL ())) -> Text -> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String (GLSL ())
parse


parse :: LT.Text -> Either String (GLSL ())
parse :: Text -> Either String (GLSL ())
parse = Text -> Either String (GLSL ())
forall a. Annot a => Text -> Either String (GLSL a)
parseShader

optimize :: Annot a => GLSL a -> GLSL a
optimize :: GLSL a -> GLSL a
optimize = (GLSL a -> (Any -> Any) -> GLSL a
forall a b. a -> b -> a
`const` Any -> Any
forall a. a -> a
id)
  -- . foldr (.) id (replicate 20 $ Deinline.pass Deinline.defaultConfig{Deinline.windowSize=5})
  -- . foldr (.) id (replicate 30 $ Deinline.pass Deinline.defaultConfig{Deinline.windowSize=10})
  (GLSL a -> GLSL a) -> (GLSL a -> GLSL a) -> GLSL a -> GLSL a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> GLSL a -> GLSL a
forall a. Annot a => Config -> GLSL a -> GLSL a
Deinline.pass Config
Deinline.defaultConfig{windowSize :: Int
Deinline.windowSize=Int
10}


main :: IO ()
main :: IO ()
main = do
  String -> IO ()
putStrLn String
"Loading shader source..."
  -- inText <- IO.readFile "../large-shaders/lambdacnc.frag"
  -- inText <- IO.readFile "../large-shaders/lambdacnc.vert"
  -- inText <- IO.readFile "../large-shaders/lambdaray.frag"
  -- inText <- IO.readFile "../large-shaders/xax.frag"
  Text
inText <- String -> IO Text
IO.readFile String
"../large-shaders/xax.vert"
  -- inText <- IO.readFile "../large-shaders/small.vert"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
False (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Parser (GLSL ()) -> Text -> IO ()
forall a. Show a => Parser a -> Text -> IO ()
parseTest (Parser (GLSL ())
forall a. Annot a => Parser (GLSL a)
parseGLSL :: Parser (GLSL ())) Text
inText
  String -> IO ()
putStrLn String
"Parsing shader source..."
  case Text -> Either String (GLSL ())
parse Text
inText of
    Left String
err -> String -> String -> IO ()
writeFile String
"../opt.glsl" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"// Error\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err
    Right GLSL ()
ok -> do
      String -> IO ()
putStrLn String
"Computing liveness..."
      let ls :: GLSL Liveness
ls = GLSL () -> GLSL Liveness
forall a. GLSL a -> GLSL Liveness
Liveness.computeLiveness GLSL ()
ok
      String -> IO ()
putStrLn String
"Optimizing shader..."
      String -> Text -> IO ()
IO.writeFile String
"../opt.glsl" (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ GLSL Liveness -> Text
forall a. Annot a => GLSL a -> Text
printShader (GLSL Liveness -> Text) -> GLSL Liveness -> Text
forall a b. (a -> b) -> a -> b
$ GLSL Liveness -> GLSL Liveness
forall a. Annot a => GLSL a -> GLSL a
optimize GLSL Liveness
ls