{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Graphics.GPipe.Debugger.Compile where

import qualified Data.Text.Lazy               as LT
import           Graphics.GPipe.Internal.Expr
import           Graphics.GPipe.Linear        (V2, V3, V4)


class ResultValue a where
  resultExpr :: a -> ExprM LT.Text
  resultType :: a -> SType

instance ResultValue (S x Float) where
  resultExpr :: S x Float -> ExprM Text
resultExpr = S x Float -> ExprM Text
forall x a. S x a -> ExprM Text
unS
  resultType :: S x Float -> SType
resultType S x Float
_ = SType
STypeFloat

instance ResultValue (V2 (S x Float)) where
  resultExpr :: V2 (S x Float) -> ExprM Text
resultExpr = S x (V2 Float) -> ExprM Text
forall x a. S x a -> ExprM Text
unS (S x (V2 Float) -> ExprM Text)
-> (V2 (S x Float) -> S x (V2 Float))
-> V2 (S x Float)
-> ExprM Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 (S x Float) -> S x (V2 Float)
forall x. V2 (S x Float) -> S x (V2 Float)
fromVec2
  resultType :: V2 (S x Float) -> SType
resultType V2 (S x Float)
_ = Int -> SType
STypeVec Int
2

instance ResultValue (V3 (S x Float)) where
  resultExpr :: V3 (S x Float) -> ExprM Text
resultExpr = S x (V3 Float) -> ExprM Text
forall x a. S x a -> ExprM Text
unS (S x (V3 Float) -> ExprM Text)
-> (V3 (S x Float) -> S x (V3 Float))
-> V3 (S x Float)
-> ExprM Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V3 (S x Float) -> S x (V3 Float)
forall x. V3 (S x Float) -> S x (V3 Float)
fromVec3
  resultType :: V3 (S x Float) -> SType
resultType V3 (S x Float)
_ = Int -> SType
STypeVec Int
3

instance ResultValue (V4 (S x Float)) where
  resultExpr :: V4 (S x Float) -> ExprM Text
resultExpr = S x (V4 Float) -> ExprM Text
forall x a. S x a -> ExprM Text
unS (S x (V4 Float) -> ExprM Text)
-> (V4 (S x Float) -> S x (V4 Float))
-> V4 (S x Float)
-> ExprM Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V4 (S x Float) -> S x (V4 Float)
forall x. V4 (S x Float) -> S x (V4 Float)
fromVec4
  resultType :: V4 (S x Float) -> SType
resultType V4 (S x Float)
_ = Int -> SType
STypeVec Int
4


compile :: ResultValue a => a -> IO LT.Text
compile :: a -> IO Text
compile a
expr =
  (ExprResult -> Text) -> IO ExprResult -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExprResult -> Text
finalSource
  (IO ExprResult -> IO Text) -> IO ExprResult -> IO Text
forall a b. (a -> b) -> a -> b
$ GlobDeclM () -> ExprM () -> IO ExprResult
runExprM (Text -> GlobDeclM ()
tellGlobalLn (Text -> GlobDeclM ()) -> Text -> GlobDeclM ()
forall a b. (a -> b) -> a -> b
$ Text
"out " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SType -> Text
stypeName (a -> SType
forall a. ResultValue a => a -> SType
resultType a
expr) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" out0")
  (ExprM () -> IO ExprResult) -> ExprM () -> IO ExprResult
forall a b. (a -> b) -> a -> b
$ a -> ExprM Text
forall a. ResultValue a => a -> ExprM Text
resultExpr a
expr ExprM Text -> (Text -> ExprM ()) -> ExprM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Text -> ExprM ()
tellAssignment' Text
"out0"