{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE EmptyDataDecls #-}
module AST.Utils.Shader
  ( Source
  , Types(..)
  , Type(..)
  , fromChars
  , toJsStringBuilder
  )
  where


import Control.Monad (liftM)
import Data.Binary (Binary, get, put)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.UTF8 as BS_UTF8
import qualified Data.Map as Map
import qualified Data.Name as Name



-- SOURCE


newtype Source =
  Source BS.ByteString



-- TYPES


data Types =
  Types
    { _attribute :: Map.Map Name.Name Type
    , _uniform :: Map.Map Name.Name Type
    , _varying :: Map.Map Name.Name Type
    }


data Type
  = Int
  | Float
  | V2
  | V3
  | V4
  | M4
  | Texture



-- TO BUILDER


toJsStringBuilder :: Source -> B.Builder
toJsStringBuilder (Source src) =
  B.byteString src



-- FROM CHARS


fromChars :: [Char] -> Source
fromChars chars =
  Source (BS_UTF8.fromString (escape chars))


escape :: [Char] -> [Char]
escape chars =
  case chars of
    [] ->
      []

    c:cs
      | c == '\r' -> escape cs
      | c == '\n' -> '\\' : 'n'  : escape cs
      | c == '\"' -> '\\' : '"'  : escape cs
      | c == '\'' -> '\\' : '\'' : escape cs
      | c == '\\' -> '\\' : '\\' : escape cs
      | otherwise -> c : escape cs



-- BINARY


instance Binary Source where
  get = liftM Source get
  put (Source a) = put a
