{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData        #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
module Language.GLSL.Types where

import           Control.Applicative              (Applicative (..), (<|>))
import           Data.Attoparsec.ByteString.Char8 (IResult (Partial), Parser,
                                                   char, decimal, endOfInput,
                                                   many1, option, parse,
                                                   parseOnly, rational,
                                                   scientific, sepBy1)
import           Data.List                        (intersperse)
import qualified Data.Scientific                  as Sci
import qualified Data.Text.Encoding               as T
import qualified Data.Text.Lazy                   as LT
import qualified Data.Text.Lazy.Builder           as LTB
import qualified Data.Text.Lazy.Builder.Int       as LTB
import qualified Data.Text.Lazy.Builder.RealFloat as LTB


parseShader :: Annot a => LT.Text -> Either String (GLSL a)
parseShader :: Text -> Either String (GLSL a)
parseShader = Parser (GLSL a) -> ByteString -> Either String (GLSL a)
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser (GLSL a)
forall a. Annot a => Parser (GLSL a)
parseGLSL (ByteString -> Either String (GLSL a))
-> (Text -> ByteString) -> Text -> Either String (GLSL a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict

printShader :: Annot a => GLSL a -> LT.Text
printShader :: GLSL a -> Text
printShader = Builder -> Text
LTB.toLazyText (Builder -> Text) -> (GLSL a -> Builder) -> GLSL a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLSL a -> Builder
forall a. Annot a => GLSL a -> Builder
ppGLSL


data GLSL a = GLSL Version [TopDecl a]
  deriving (Int -> GLSL a -> ShowS
[GLSL a] -> ShowS
GLSL a -> String
(Int -> GLSL a -> ShowS)
-> (GLSL a -> String) -> ([GLSL a] -> ShowS) -> Show (GLSL a)
forall a. Show a => Int -> GLSL a -> ShowS
forall a. Show a => [GLSL a] -> ShowS
forall a. Show a => GLSL a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GLSL a] -> ShowS
$cshowList :: forall a. Show a => [GLSL a] -> ShowS
show :: GLSL a -> String
$cshow :: forall a. Show a => GLSL a -> String
showsPrec :: Int -> GLSL a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> GLSL a -> ShowS
Show, a -> GLSL b -> GLSL a
(a -> b) -> GLSL a -> GLSL b
(forall a b. (a -> b) -> GLSL a -> GLSL b)
-> (forall a b. a -> GLSL b -> GLSL a) -> Functor GLSL
forall a b. a -> GLSL b -> GLSL a
forall a b. (a -> b) -> GLSL a -> GLSL b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GLSL b -> GLSL a
$c<$ :: forall a b. a -> GLSL b -> GLSL a
fmap :: (a -> b) -> GLSL a -> GLSL b
$cfmap :: forall a b. (a -> b) -> GLSL a -> GLSL b
Functor, GLSL a -> Bool
(a -> m) -> GLSL a -> m
(a -> b -> b) -> b -> GLSL a -> b
(forall m. Monoid m => GLSL m -> m)
-> (forall m a. Monoid m => (a -> m) -> GLSL a -> m)
-> (forall m a. Monoid m => (a -> m) -> GLSL a -> m)
-> (forall a b. (a -> b -> b) -> b -> GLSL a -> b)
-> (forall a b. (a -> b -> b) -> b -> GLSL a -> b)
-> (forall b a. (b -> a -> b) -> b -> GLSL a -> b)
-> (forall b a. (b -> a -> b) -> b -> GLSL a -> b)
-> (forall a. (a -> a -> a) -> GLSL a -> a)
-> (forall a. (a -> a -> a) -> GLSL a -> a)
-> (forall a. GLSL a -> [a])
-> (forall a. GLSL a -> Bool)
-> (forall a. GLSL a -> Int)
-> (forall a. Eq a => a -> GLSL a -> Bool)
-> (forall a. Ord a => GLSL a -> a)
-> (forall a. Ord a => GLSL a -> a)
-> (forall a. Num a => GLSL a -> a)
-> (forall a. Num a => GLSL a -> a)
-> Foldable GLSL
forall a. Eq a => a -> GLSL a -> Bool
forall a. Num a => GLSL a -> a
forall a. Ord a => GLSL a -> a
forall m. Monoid m => GLSL m -> m
forall a. GLSL a -> Bool
forall a. GLSL a -> Int
forall a. GLSL a -> [a]
forall a. (a -> a -> a) -> GLSL a -> a
forall m a. Monoid m => (a -> m) -> GLSL a -> m
forall b a. (b -> a -> b) -> b -> GLSL a -> b
forall a b. (a -> b -> b) -> b -> GLSL a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: GLSL a -> a
$cproduct :: forall a. Num a => GLSL a -> a
sum :: GLSL a -> a
$csum :: forall a. Num a => GLSL a -> a
minimum :: GLSL a -> a
$cminimum :: forall a. Ord a => GLSL a -> a
maximum :: GLSL a -> a
$cmaximum :: forall a. Ord a => GLSL a -> a
elem :: a -> GLSL a -> Bool
$celem :: forall a. Eq a => a -> GLSL a -> Bool
length :: GLSL a -> Int
$clength :: forall a. GLSL a -> Int
null :: GLSL a -> Bool
$cnull :: forall a. GLSL a -> Bool
toList :: GLSL a -> [a]
$ctoList :: forall a. GLSL a -> [a]
foldl1 :: (a -> a -> a) -> GLSL a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> GLSL a -> a
foldr1 :: (a -> a -> a) -> GLSL a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> GLSL a -> a
foldl' :: (b -> a -> b) -> b -> GLSL a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> GLSL a -> b
foldl :: (b -> a -> b) -> b -> GLSL a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> GLSL a -> b
foldr' :: (a -> b -> b) -> b -> GLSL a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> GLSL a -> b
foldr :: (a -> b -> b) -> b -> GLSL a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> GLSL a -> b
foldMap' :: (a -> m) -> GLSL a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> GLSL a -> m
foldMap :: (a -> m) -> GLSL a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> GLSL a -> m
fold :: GLSL m -> m
$cfold :: forall m. Monoid m => GLSL m -> m
Foldable, Functor GLSL
Foldable GLSL
Functor GLSL
-> Foldable GLSL
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> GLSL a -> f (GLSL b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    GLSL (f a) -> f (GLSL a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> GLSL a -> m (GLSL b))
-> (forall (m :: * -> *) a. Monad m => GLSL (m a) -> m (GLSL a))
-> Traversable GLSL
(a -> f b) -> GLSL a -> f (GLSL b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => GLSL (m a) -> m (GLSL a)
forall (f :: * -> *) a. Applicative f => GLSL (f a) -> f (GLSL a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GLSL a -> m (GLSL b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GLSL a -> f (GLSL b)
sequence :: GLSL (m a) -> m (GLSL a)
$csequence :: forall (m :: * -> *) a. Monad m => GLSL (m a) -> m (GLSL a)
mapM :: (a -> m b) -> GLSL a -> m (GLSL b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GLSL a -> m (GLSL b)
sequenceA :: GLSL (f a) -> f (GLSL a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => GLSL (f a) -> f (GLSL a)
traverse :: (a -> f b) -> GLSL a -> f (GLSL b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GLSL a -> f (GLSL b)
$cp2Traversable :: Foldable GLSL
$cp1Traversable :: Functor GLSL
Traversable)

parseGLSL :: Annot a => Parser (GLSL a)
parseGLSL :: Parser (GLSL a)
parseGLSL = Version -> [TopDecl a] -> GLSL a
forall a. Version -> [TopDecl a] -> GLSL a
GLSL
  (Version -> [TopDecl a] -> GLSL a)
-> Parser ByteString Version
-> Parser ByteString ([TopDecl a] -> GLSL a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Version
parseVersion
  Parser ByteString ([TopDecl a] -> GLSL a)
-> Parser ByteString [TopDecl a] -> Parser (GLSL a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
"\n" Parser ByteString ByteString
-> Parser ByteString [TopDecl a] -> Parser ByteString [TopDecl a]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString (TopDecl a) -> Parser ByteString [TopDecl a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser ByteString (TopDecl a)
forall a. Annot a => Parser (TopDecl a)
parseTopDecl Parser ByteString [TopDecl a]
-> ([TopDecl a] -> Parser ByteString [TopDecl a])
-> Parser ByteString [TopDecl a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput Parser ByteString ()
-> Parser ByteString [TopDecl a] -> Parser ByteString [TopDecl a]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser ByteString [TopDecl a] -> Parser ByteString [TopDecl a])
-> ([TopDecl a] -> Parser ByteString [TopDecl a])
-> [TopDecl a]
-> Parser ByteString [TopDecl a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TopDecl a] -> Parser ByteString [TopDecl a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

ppGLSL :: Annot a => GLSL a -> LTB.Builder
ppGLSL :: GLSL a -> Builder
ppGLSL (GLSL Version
v [TopDecl a]
decls) =
  Version -> Builder
ppVersion Version
v
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (TopDecl a -> Builder) -> [TopDecl a] -> Builder
forall a. (a -> Builder) -> [a] -> Builder
ppL TopDecl a -> Builder
forall a. Annot a => TopDecl a -> Builder
ppTopDecl [TopDecl a]
decls

newtype Version = Version Int
  deriving (Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show)

parseVersion :: Parser Version
parseVersion :: Parser ByteString Version
parseVersion = Int -> Version
Version (Int -> Version)
-> Parser ByteString Int -> Parser ByteString Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
"#version " Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString Int
forall a. Integral a => Parser a
decimal)

ppVersion :: Version -> LTB.Builder
ppVersion :: Version -> Builder
ppVersion (Version Int
v) = Builder
"#version " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
ppInt Int
v

data TopDecl a
  = LayoutDecl LayoutSpec GlobalDecl
  | GlobalDecl GlobalDecl
  | ProcDecl ProcName [ParamDecl] [StmtAnnot a]
  deriving (Int -> TopDecl a -> ShowS
[TopDecl a] -> ShowS
TopDecl a -> String
(Int -> TopDecl a -> ShowS)
-> (TopDecl a -> String)
-> ([TopDecl a] -> ShowS)
-> Show (TopDecl a)
forall a. Show a => Int -> TopDecl a -> ShowS
forall a. Show a => [TopDecl a] -> ShowS
forall a. Show a => TopDecl a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TopDecl a] -> ShowS
$cshowList :: forall a. Show a => [TopDecl a] -> ShowS
show :: TopDecl a -> String
$cshow :: forall a. Show a => TopDecl a -> String
showsPrec :: Int -> TopDecl a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> TopDecl a -> ShowS
Show, a -> TopDecl b -> TopDecl a
(a -> b) -> TopDecl a -> TopDecl b
(forall a b. (a -> b) -> TopDecl a -> TopDecl b)
-> (forall a b. a -> TopDecl b -> TopDecl a) -> Functor TopDecl
forall a b. a -> TopDecl b -> TopDecl a
forall a b. (a -> b) -> TopDecl a -> TopDecl b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TopDecl b -> TopDecl a
$c<$ :: forall a b. a -> TopDecl b -> TopDecl a
fmap :: (a -> b) -> TopDecl a -> TopDecl b
$cfmap :: forall a b. (a -> b) -> TopDecl a -> TopDecl b
Functor, TopDecl a -> Bool
(a -> m) -> TopDecl a -> m
(a -> b -> b) -> b -> TopDecl a -> b
(forall m. Monoid m => TopDecl m -> m)
-> (forall m a. Monoid m => (a -> m) -> TopDecl a -> m)
-> (forall m a. Monoid m => (a -> m) -> TopDecl a -> m)
-> (forall a b. (a -> b -> b) -> b -> TopDecl a -> b)
-> (forall a b. (a -> b -> b) -> b -> TopDecl a -> b)
-> (forall b a. (b -> a -> b) -> b -> TopDecl a -> b)
-> (forall b a. (b -> a -> b) -> b -> TopDecl a -> b)
-> (forall a. (a -> a -> a) -> TopDecl a -> a)
-> (forall a. (a -> a -> a) -> TopDecl a -> a)
-> (forall a. TopDecl a -> [a])
-> (forall a. TopDecl a -> Bool)
-> (forall a. TopDecl a -> Int)
-> (forall a. Eq a => a -> TopDecl a -> Bool)
-> (forall a. Ord a => TopDecl a -> a)
-> (forall a. Ord a => TopDecl a -> a)
-> (forall a. Num a => TopDecl a -> a)
-> (forall a. Num a => TopDecl a -> a)
-> Foldable TopDecl
forall a. Eq a => a -> TopDecl a -> Bool
forall a. Num a => TopDecl a -> a
forall a. Ord a => TopDecl a -> a
forall m. Monoid m => TopDecl m -> m
forall a. TopDecl a -> Bool
forall a. TopDecl a -> Int
forall a. TopDecl a -> [a]
forall a. (a -> a -> a) -> TopDecl a -> a
forall m a. Monoid m => (a -> m) -> TopDecl a -> m
forall b a. (b -> a -> b) -> b -> TopDecl a -> b
forall a b. (a -> b -> b) -> b -> TopDecl a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: TopDecl a -> a
$cproduct :: forall a. Num a => TopDecl a -> a
sum :: TopDecl a -> a
$csum :: forall a. Num a => TopDecl a -> a
minimum :: TopDecl a -> a
$cminimum :: forall a. Ord a => TopDecl a -> a
maximum :: TopDecl a -> a
$cmaximum :: forall a. Ord a => TopDecl a -> a
elem :: a -> TopDecl a -> Bool
$celem :: forall a. Eq a => a -> TopDecl a -> Bool
length :: TopDecl a -> Int
$clength :: forall a. TopDecl a -> Int
null :: TopDecl a -> Bool
$cnull :: forall a. TopDecl a -> Bool
toList :: TopDecl a -> [a]
$ctoList :: forall a. TopDecl a -> [a]
foldl1 :: (a -> a -> a) -> TopDecl a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> TopDecl a -> a
foldr1 :: (a -> a -> a) -> TopDecl a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> TopDecl a -> a
foldl' :: (b -> a -> b) -> b -> TopDecl a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> TopDecl a -> b
foldl :: (b -> a -> b) -> b -> TopDecl a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> TopDecl a -> b
foldr' :: (a -> b -> b) -> b -> TopDecl a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> TopDecl a -> b
foldr :: (a -> b -> b) -> b -> TopDecl a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> TopDecl a -> b
foldMap' :: (a -> m) -> TopDecl a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> TopDecl a -> m
foldMap :: (a -> m) -> TopDecl a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> TopDecl a -> m
fold :: TopDecl m -> m
$cfold :: forall m. Monoid m => TopDecl m -> m
Foldable, Functor TopDecl
Foldable TopDecl
Functor TopDecl
-> Foldable TopDecl
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> TopDecl a -> f (TopDecl b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    TopDecl (f a) -> f (TopDecl a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> TopDecl a -> m (TopDecl b))
-> (forall (m :: * -> *) a.
    Monad m =>
    TopDecl (m a) -> m (TopDecl a))
-> Traversable TopDecl
(a -> f b) -> TopDecl a -> f (TopDecl b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => TopDecl (m a) -> m (TopDecl a)
forall (f :: * -> *) a.
Applicative f =>
TopDecl (f a) -> f (TopDecl a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TopDecl a -> m (TopDecl b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TopDecl a -> f (TopDecl b)
sequence :: TopDecl (m a) -> m (TopDecl a)
$csequence :: forall (m :: * -> *) a. Monad m => TopDecl (m a) -> m (TopDecl a)
mapM :: (a -> m b) -> TopDecl a -> m (TopDecl b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TopDecl a -> m (TopDecl b)
sequenceA :: TopDecl (f a) -> f (TopDecl a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
TopDecl (f a) -> f (TopDecl a)
traverse :: (a -> f b) -> TopDecl a -> f (TopDecl b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TopDecl a -> f (TopDecl b)
$cp2Traversable :: Foldable TopDecl
$cp1Traversable :: Functor TopDecl
Traversable)

parseTopDecl :: Annot a => Parser (TopDecl a)
parseTopDecl :: Parser (TopDecl a)
parseTopDecl = Parser (TopDecl a)
forall a. Parser ByteString (TopDecl a)
layoutDecl Parser (TopDecl a) -> Parser (TopDecl a) -> Parser (TopDecl a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (TopDecl a)
forall a. Parser ByteString (TopDecl a)
globalDecl Parser (TopDecl a) -> Parser (TopDecl a) -> Parser (TopDecl a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (TopDecl a)
procDecl
  where
    layoutDecl :: Parser ByteString (TopDecl a)
layoutDecl = LayoutSpec -> GlobalDecl -> TopDecl a
forall a. LayoutSpec -> GlobalDecl -> TopDecl a
LayoutDecl
      (LayoutSpec -> GlobalDecl -> TopDecl a)
-> Parser ByteString LayoutSpec
-> Parser ByteString (GlobalDecl -> TopDecl a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
"layout(" Parser ByteString ByteString
-> Parser ByteString LayoutSpec -> Parser ByteString LayoutSpec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString LayoutSpec
parseLayoutSpec)
      Parser ByteString (GlobalDecl -> TopDecl a)
-> Parser ByteString GlobalDecl -> Parser ByteString (TopDecl a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
") " Parser ByteString ByteString
-> Parser ByteString GlobalDecl -> Parser ByteString GlobalDecl
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString GlobalDecl
parseGlobalDecl)

    globalDecl :: Parser ByteString (TopDecl a)
globalDecl = GlobalDecl -> TopDecl a
forall a. GlobalDecl -> TopDecl a
GlobalDecl
      (GlobalDecl -> TopDecl a)
-> Parser ByteString GlobalDecl -> Parser ByteString (TopDecl a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString GlobalDecl
parseGlobalDecl

    procDecl :: Parser (TopDecl a)
procDecl = ProcName -> [ParamDecl] -> [StmtAnnot a] -> TopDecl a
forall a. ProcName -> [ParamDecl] -> [StmtAnnot a] -> TopDecl a
ProcDecl
      (ProcName -> [ParamDecl] -> [StmtAnnot a] -> TopDecl a)
-> Parser ByteString ProcName
-> Parser ByteString ([ParamDecl] -> [StmtAnnot a] -> TopDecl a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
"void " Parser ByteString ByteString
-> Parser ByteString ProcName -> Parser ByteString ProcName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString ProcName
parseProcName)
      Parser ByteString ([ParamDecl] -> [StmtAnnot a] -> TopDecl a)
-> Parser ByteString [ParamDecl]
-> Parser ByteString ([StmtAnnot a] -> TopDecl a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
"() " Parser ByteString ByteString
-> Parser ByteString [ParamDecl] -> Parser ByteString [ParamDecl]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ParamDecl] -> Parser ByteString [ParamDecl]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
      -- <*> ("{\n" >> many1 parseStmtAnnot)
      Parser ByteString ([StmtAnnot a] -> TopDecl a)
-> Parser ByteString [StmtAnnot a] -> Parser (TopDecl a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
"{\n" Parser ByteString ByteString
-> Parser ByteString [StmtAnnot a]
-> Parser ByteString [StmtAnnot a]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString (StmtAnnot a) -> Parser ByteString [StmtAnnot a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser ByteString (StmtAnnot a)
forall a. Annot a => Parser (StmtAnnot a)
parseStmtAnnot Parser ByteString [StmtAnnot a]
-> ([StmtAnnot a] -> Parser ByteString [StmtAnnot a])
-> Parser ByteString [StmtAnnot a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Parser ByteString ByteString
"}\n" Parser ByteString ByteString
-> Parser ByteString [StmtAnnot a]
-> Parser ByteString [StmtAnnot a]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser ByteString [StmtAnnot a]
 -> Parser ByteString [StmtAnnot a])
-> ([StmtAnnot a] -> Parser ByteString [StmtAnnot a])
-> [StmtAnnot a]
-> Parser ByteString [StmtAnnot a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StmtAnnot a] -> Parser ByteString [StmtAnnot a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

ppTopDecl :: Annot a => TopDecl a -> LTB.Builder
ppTopDecl :: TopDecl a -> Builder
ppTopDecl (LayoutDecl LayoutSpec
e GlobalDecl
d) = Builder
"layout(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> LayoutSpec -> Builder
ppLayoutSpec LayoutSpec
e Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
") " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> GlobalDecl -> Builder
ppGlobalDecl GlobalDecl
d
ppTopDecl (GlobalDecl GlobalDecl
d) = GlobalDecl -> Builder
ppGlobalDecl GlobalDecl
d
ppTopDecl (ProcDecl ProcName
n [ParamDecl]
a [StmtAnnot a]
b) =
  Builder
"void " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProcName -> Builder
ppProcName ProcName
n
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> (ParamDecl -> Builder) -> [ParamDecl] -> Builder
forall a. Builder -> (a -> Builder) -> [a] -> Builder
ppS Builder
"," ParamDecl -> Builder
ppParamDecl [ParamDecl]
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
") {\n"
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (StmtAnnot a -> Builder) -> [StmtAnnot a] -> Builder
forall a. (a -> Builder) -> [a] -> Builder
ppL StmtAnnot a -> Builder
forall a. Annot a => StmtAnnot a -> Builder
ppStmtAnnot [StmtAnnot a]
b
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}\n"

data ProcName
  = ProcMain
  | ProcName NameId
  deriving (Int -> ProcName -> ShowS
[ProcName] -> ShowS
ProcName -> String
(Int -> ProcName -> ShowS)
-> (ProcName -> String) -> ([ProcName] -> ShowS) -> Show ProcName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProcName] -> ShowS
$cshowList :: [ProcName] -> ShowS
show :: ProcName -> String
$cshow :: ProcName -> String
showsPrec :: Int -> ProcName -> ShowS
$cshowsPrec :: Int -> ProcName -> ShowS
Show)

parseProcName :: Parser ProcName
parseProcName :: Parser ByteString ProcName
parseProcName =
  (Parser ByteString ByteString
"main" Parser ByteString ByteString
-> Parser ByteString ProcName -> Parser ByteString ProcName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcName -> Parser ByteString ProcName
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProcName
ProcMain)
  Parser ByteString ProcName
-> Parser ByteString ProcName -> Parser ByteString ProcName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"p" Parser ByteString ByteString
-> Parser ByteString ProcName -> Parser ByteString ProcName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> NameId -> ProcName
ProcName (NameId -> ProcName)
-> Parser ByteString NameId -> Parser ByteString ProcName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString NameId
parseNameId)

ppProcName :: ProcName -> LTB.Builder
ppProcName :: ProcName -> Builder
ppProcName ProcName
ProcMain     = Builder
"main"
ppProcName (ProcName NameId
n) = Builder
"p" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameId -> Builder
ppNameId NameId
n

data LayoutSpec
  = LayoutStd140
  | LayoutLocation Int
  deriving (Int -> LayoutSpec -> ShowS
[LayoutSpec] -> ShowS
LayoutSpec -> String
(Int -> LayoutSpec -> ShowS)
-> (LayoutSpec -> String)
-> ([LayoutSpec] -> ShowS)
-> Show LayoutSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayoutSpec] -> ShowS
$cshowList :: [LayoutSpec] -> ShowS
show :: LayoutSpec -> String
$cshow :: LayoutSpec -> String
showsPrec :: Int -> LayoutSpec -> ShowS
$cshowsPrec :: Int -> LayoutSpec -> ShowS
Show)

parseLayoutSpec :: Parser LayoutSpec
parseLayoutSpec :: Parser ByteString LayoutSpec
parseLayoutSpec =
  (Parser ByteString ByteString
"std140" Parser ByteString ByteString
-> Parser ByteString LayoutSpec -> Parser ByteString LayoutSpec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LayoutSpec -> Parser ByteString LayoutSpec
forall (f :: * -> *) a. Applicative f => a -> f a
pure LayoutSpec
LayoutStd140)
  Parser ByteString LayoutSpec
-> Parser ByteString LayoutSpec -> Parser ByteString LayoutSpec
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"location = " Parser ByteString ByteString
-> Parser ByteString LayoutSpec -> Parser ByteString LayoutSpec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> LayoutSpec
LayoutLocation (Int -> LayoutSpec)
-> Parser ByteString Int -> Parser ByteString LayoutSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int
forall a. Integral a => Parser a
decimal)

ppLayoutSpec :: LayoutSpec -> LTB.Builder
ppLayoutSpec :: LayoutSpec -> Builder
ppLayoutSpec LayoutSpec
LayoutStd140       = Builder
"std140"
ppLayoutSpec (LayoutLocation Int
l) = Builder
"location = " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
ppInt Int
l

data ParamDecl
  = Param ParamKind LocalDecl
  deriving (Int -> ParamDecl -> ShowS
[ParamDecl] -> ShowS
ParamDecl -> String
(Int -> ParamDecl -> ShowS)
-> (ParamDecl -> String)
-> ([ParamDecl] -> ShowS)
-> Show ParamDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParamDecl] -> ShowS
$cshowList :: [ParamDecl] -> ShowS
show :: ParamDecl -> String
$cshow :: ParamDecl -> String
showsPrec :: Int -> ParamDecl -> ShowS
$cshowsPrec :: Int -> ParamDecl -> ShowS
Show)

parseParamDecl :: Parser ParamDecl
parseParamDecl :: Parser ParamDecl
parseParamDecl = ParamKind -> LocalDecl -> ParamDecl
Param
  (ParamKind -> LocalDecl -> ParamDecl)
-> Parser ByteString ParamKind
-> Parser ByteString (LocalDecl -> ParamDecl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ParamKind
parseParamKind
  Parser ByteString (LocalDecl -> ParamDecl)
-> Parser ByteString LocalDecl -> Parser ParamDecl
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" " Parser ByteString ByteString
-> Parser ByteString LocalDecl -> Parser ByteString LocalDecl
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString LocalDecl
parseLocalDecl)

ppParamDecl :: ParamDecl -> LTB.Builder
ppParamDecl :: ParamDecl -> Builder
ppParamDecl (Param ParamKind
k LocalDecl
d) =
  ParamKind -> Builder
ppParamKind ParamKind
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> LocalDecl -> Builder
ppLocalDecl LocalDecl
d

data ParamKind
  = PkIn
  | PkOut
  | PkInout
  deriving (Int -> ParamKind -> ShowS
[ParamKind] -> ShowS
ParamKind -> String
(Int -> ParamKind -> ShowS)
-> (ParamKind -> String)
-> ([ParamKind] -> ShowS)
-> Show ParamKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParamKind] -> ShowS
$cshowList :: [ParamKind] -> ShowS
show :: ParamKind -> String
$cshow :: ParamKind -> String
showsPrec :: Int -> ParamKind -> ShowS
$cshowsPrec :: Int -> ParamKind -> ShowS
Show)

parseParamKind :: Parser ParamKind
parseParamKind :: Parser ByteString ParamKind
parseParamKind = (Char -> Parser Char
char Char
' ' Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
' ') Parser Char
-> Parser ByteString ParamKind -> Parser ByteString ParamKind
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  (Parser ByteString ByteString
"in" Parser ByteString ByteString
-> Parser ByteString ParamKind -> Parser ByteString ParamKind
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParamKind -> Parser ByteString ParamKind
forall (m :: * -> *) a. Monad m => a -> m a
return ParamKind
PkIn) Parser ByteString ParamKind
-> Parser ByteString ParamKind -> Parser ByteString ParamKind
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Parser ByteString ByteString
"out" Parser ByteString ByteString
-> Parser ByteString ParamKind -> Parser ByteString ParamKind
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParamKind -> Parser ByteString ParamKind
forall (m :: * -> *) a. Monad m => a -> m a
return ParamKind
PkOut) Parser ByteString ParamKind
-> Parser ByteString ParamKind -> Parser ByteString ParamKind
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Parser ByteString ByteString
"inout" Parser ByteString ByteString
-> Parser ByteString ParamKind -> Parser ByteString ParamKind
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParamKind -> Parser ByteString ParamKind
forall (m :: * -> *) a. Monad m => a -> m a
return ParamKind
PkInout)

ppParamKind :: ParamKind -> LTB.Builder
ppParamKind :: ParamKind -> Builder
ppParamKind ParamKind
PkIn    = Builder
"in"
ppParamKind ParamKind
PkOut   = Builder
"out"
ppParamKind ParamKind
PkInout = Builder
"inout"

data LocalDecl
  = LDecl Type NameId (Maybe Expr)
  deriving (Int -> LocalDecl -> ShowS
[LocalDecl] -> ShowS
LocalDecl -> String
(Int -> LocalDecl -> ShowS)
-> (LocalDecl -> String)
-> ([LocalDecl] -> ShowS)
-> Show LocalDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocalDecl] -> ShowS
$cshowList :: [LocalDecl] -> ShowS
show :: LocalDecl -> String
$cshow :: LocalDecl -> String
showsPrec :: Int -> LocalDecl -> ShowS
$cshowsPrec :: Int -> LocalDecl -> ShowS
Show)

parseLocalDecl :: Parser LocalDecl
parseLocalDecl :: Parser ByteString LocalDecl
parseLocalDecl = Type -> NameId -> Maybe Expr -> LocalDecl
LDecl
  (Type -> NameId -> Maybe Expr -> LocalDecl)
-> Parser ByteString Type
-> Parser ByteString (NameId -> Maybe Expr -> LocalDecl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Type
parseType
  Parser ByteString (NameId -> Maybe Expr -> LocalDecl)
-> Parser ByteString NameId
-> Parser ByteString (Maybe Expr -> LocalDecl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" t" Parser ByteString ByteString
-> Parser ByteString NameId -> Parser ByteString NameId
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString NameId
parseNameId)
  Parser ByteString (Maybe Expr -> LocalDecl)
-> Parser ByteString (Maybe Expr) -> Parser ByteString LocalDecl
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Expr
-> Parser ByteString (Maybe Expr) -> Parser ByteString (Maybe Expr)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Maybe Expr
forall a. Maybe a
Nothing (Parser ByteString ByteString
" = " Parser ByteString ByteString
-> Parser ByteString (Maybe Expr) -> Parser ByteString (Maybe Expr)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr)
-> Parser ByteString Expr -> Parser ByteString (Maybe Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Expr
parseExpr) Parser ByteString (Maybe Expr)
-> (Maybe Expr -> Parser ByteString (Maybe Expr))
-> Parser ByteString (Maybe Expr)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Parser ByteString ByteString
";\n" Parser ByteString ByteString
-> Parser ByteString (Maybe Expr) -> Parser ByteString (Maybe Expr)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser ByteString (Maybe Expr) -> Parser ByteString (Maybe Expr))
-> (Maybe Expr -> Parser ByteString (Maybe Expr))
-> Maybe Expr
-> Parser ByteString (Maybe Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Expr -> Parser ByteString (Maybe Expr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

ppLocalDecl :: LocalDecl -> LTB.Builder
ppLocalDecl :: LocalDecl -> Builder
ppLocalDecl (LDecl Type
t NameId
n Maybe Expr
Nothing) =
  Type -> Builder
ppType Type
t
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" t" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameId -> Builder
ppNameId NameId
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";\n"
ppLocalDecl (LDecl Type
t NameId
n (Just Expr
e)) =
  Type -> Builder
ppType Type
t
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" t" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameId -> Builder
ppNameId NameId
n
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" = " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Expr -> Builder
ppExpr Expr
e Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";\n"

data GlobalDecl
  = GDecl GDeclKind Type Name
  deriving (Int -> GlobalDecl -> ShowS
[GlobalDecl] -> ShowS
GlobalDecl -> String
(Int -> GlobalDecl -> ShowS)
-> (GlobalDecl -> String)
-> ([GlobalDecl] -> ShowS)
-> Show GlobalDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobalDecl] -> ShowS
$cshowList :: [GlobalDecl] -> ShowS
show :: GlobalDecl -> String
$cshow :: GlobalDecl -> String
showsPrec :: Int -> GlobalDecl -> ShowS
$cshowsPrec :: Int -> GlobalDecl -> ShowS
Show)

parseGlobalDecl :: Parser GlobalDecl
parseGlobalDecl :: Parser ByteString GlobalDecl
parseGlobalDecl = GDeclKind -> Type -> Name -> GlobalDecl
GDecl
  (GDeclKind -> Type -> Name -> GlobalDecl)
-> Parser ByteString GDeclKind
-> Parser ByteString (Type -> Name -> GlobalDecl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString GDeclKind
parseGDeclKind
  Parser ByteString (Type -> Name -> GlobalDecl)
-> Parser ByteString Type -> Parser ByteString (Name -> GlobalDecl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" " Parser ByteString ByteString
-> Parser ByteString Type -> Parser ByteString Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString Type
parseType)
  Parser ByteString (Name -> GlobalDecl)
-> Parser ByteString Name -> Parser ByteString GlobalDecl
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" " Parser ByteString ByteString
-> Parser ByteString Name -> Parser ByteString Name
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString Name
parseName Parser ByteString Name
-> (Name -> Parser ByteString Name) -> Parser ByteString Name
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Parser ByteString ByteString
";\n" Parser ByteString ByteString
-> Parser ByteString Name -> Parser ByteString Name
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser ByteString Name -> Parser ByteString Name)
-> (Name -> Parser ByteString Name)
-> Name
-> Parser ByteString Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Parser ByteString Name
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

ppGlobalDecl :: GlobalDecl -> LTB.Builder
ppGlobalDecl :: GlobalDecl -> Builder
ppGlobalDecl (GDecl GDeclKind
k Type
t Name
n) =
  GDeclKind -> Builder
ppGDeclKind GDeclKind
k
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Type -> Builder
ppType Type
t
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Name -> Builder
ppName Name
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";\n"

data GDeclKind
  = GkIn
  | GkOut
  | GkUniform
  deriving (Int -> GDeclKind -> ShowS
[GDeclKind] -> ShowS
GDeclKind -> String
(Int -> GDeclKind -> ShowS)
-> (GDeclKind -> String)
-> ([GDeclKind] -> ShowS)
-> Show GDeclKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GDeclKind] -> ShowS
$cshowList :: [GDeclKind] -> ShowS
show :: GDeclKind -> String
$cshow :: GDeclKind -> String
showsPrec :: Int -> GDeclKind -> ShowS
$cshowsPrec :: Int -> GDeclKind -> ShowS
Show)

parseGDeclKind :: Parser GDeclKind
parseGDeclKind :: Parser ByteString GDeclKind
parseGDeclKind =
  (Parser ByteString ByteString
"in" Parser ByteString ByteString
-> Parser ByteString GDeclKind -> Parser ByteString GDeclKind
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GDeclKind -> Parser ByteString GDeclKind
forall (m :: * -> *) a. Monad m => a -> m a
return GDeclKind
GkIn) Parser ByteString GDeclKind
-> Parser ByteString GDeclKind -> Parser ByteString GDeclKind
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Parser ByteString ByteString
"out" Parser ByteString ByteString
-> Parser ByteString GDeclKind -> Parser ByteString GDeclKind
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GDeclKind -> Parser ByteString GDeclKind
forall (m :: * -> *) a. Monad m => a -> m a
return GDeclKind
GkOut) Parser ByteString GDeclKind
-> Parser ByteString GDeclKind -> Parser ByteString GDeclKind
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Parser ByteString ByteString
"uniform" Parser ByteString ByteString
-> Parser ByteString GDeclKind -> Parser ByteString GDeclKind
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GDeclKind -> Parser ByteString GDeclKind
forall (m :: * -> *) a. Monad m => a -> m a
return GDeclKind
GkUniform)

ppGDeclKind :: GDeclKind -> LTB.Builder
ppGDeclKind :: GDeclKind -> Builder
ppGDeclKind GDeclKind
GkIn      = Builder
"in"
ppGDeclKind GDeclKind
GkOut     = Builder
"out"
ppGDeclKind GDeclKind
GkUniform = Builder
"uniform"

data Type
  = TyBool
  | TyFloat
  | TySampler2D
  | TyVec Int
  | TyMat Int Int
  | TyStruct NameId [(Type, NameId)]
  deriving (Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show, Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq)

parseType :: Parser Type
parseType :: Parser ByteString Type
parseType =
  (Parser ByteString ByteString
"bool" Parser ByteString ByteString
-> Parser ByteString Type -> Parser ByteString Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type -> Parser ByteString Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
TyBool)
  Parser ByteString Type
-> Parser ByteString Type -> Parser ByteString Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"float" Parser ByteString ByteString
-> Parser ByteString Type -> Parser ByteString Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type -> Parser ByteString Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
TyFloat)
  Parser ByteString Type
-> Parser ByteString Type -> Parser ByteString Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"sampler2D" Parser ByteString ByteString
-> Parser ByteString Type -> Parser ByteString Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type -> Parser ByteString Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
TySampler2D)
  Parser ByteString Type
-> Parser ByteString Type -> Parser ByteString Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"vec" Parser ByteString ByteString
-> Parser ByteString Type -> Parser ByteString Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Type
TyVec (Int -> Type) -> Parser ByteString Int -> Parser ByteString Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int
forall a. Integral a => Parser a
decimal)
  Parser ByteString Type
-> Parser ByteString Type -> Parser ByteString Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"mat" Parser ByteString ByteString
-> Parser ByteString Type -> Parser ByteString Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> Type
TyMat (Int -> Int -> Type)
-> Parser ByteString Int -> Parser ByteString (Int -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int
forall a. Integral a => Parser a
decimal Parser ByteString (Int -> Type)
-> Parser ByteString Int -> Parser ByteString Type
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
"x" Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString Int
forall a. Integral a => Parser a
decimal))
  Parser ByteString Type
-> Parser ByteString Type -> Parser ByteString Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Type
tyStruct
  where
    tyStruct :: Parser ByteString Type
tyStruct = NameId -> [(Type, NameId)] -> Type
TyStruct
      (NameId -> [(Type, NameId)] -> Type)
-> Parser ByteString NameId
-> Parser ByteString ([(Type, NameId)] -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
"uBlock" Parser ByteString ByteString
-> Parser ByteString NameId -> Parser ByteString NameId
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString NameId
parseNameId)
      Parser ByteString ([(Type, NameId)] -> Type)
-> Parser ByteString [(Type, NameId)] -> Parser ByteString Type
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" {\n" Parser ByteString ByteString
-> Parser ByteString [(Type, NameId)]
-> Parser ByteString [(Type, NameId)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString (Type, NameId)
-> Parser ByteString [(Type, NameId)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser ByteString (Type, NameId)
parseStructMember Parser ByteString [(Type, NameId)]
-> ([(Type, NameId)] -> Parser ByteString [(Type, NameId)])
-> Parser ByteString [(Type, NameId)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Parser ByteString ByteString
"}" Parser ByteString ByteString
-> Parser ByteString [(Type, NameId)]
-> Parser ByteString [(Type, NameId)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser ByteString [(Type, NameId)]
 -> Parser ByteString [(Type, NameId)])
-> ([(Type, NameId)] -> Parser ByteString [(Type, NameId)])
-> [(Type, NameId)]
-> Parser ByteString [(Type, NameId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Type, NameId)] -> Parser ByteString [(Type, NameId)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

    parseStructMember :: Parser (Type, NameId)
    parseStructMember :: Parser ByteString (Type, NameId)
parseStructMember = (,)
      (Type -> NameId -> (Type, NameId))
-> Parser ByteString Type
-> Parser ByteString (NameId -> (Type, NameId))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Type
parseType
      Parser ByteString (NameId -> (Type, NameId))
-> Parser ByteString NameId -> Parser ByteString (Type, NameId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" u" Parser ByteString ByteString
-> Parser ByteString NameId -> Parser ByteString NameId
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString NameId
parseNameId Parser ByteString NameId
-> (NameId -> Parser ByteString NameId) -> Parser ByteString NameId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Parser ByteString ByteString
";\n" Parser ByteString ByteString
-> Parser ByteString NameId -> Parser ByteString NameId
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser ByteString NameId -> Parser ByteString NameId)
-> (NameId -> Parser ByteString NameId)
-> NameId
-> Parser ByteString NameId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameId -> Parser ByteString NameId
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

ppType :: Type -> LTB.Builder
ppType :: Type -> Builder
ppType Type
TyBool = Builder
"bool"
ppType Type
TyFloat = Builder
"float"
ppType Type
TySampler2D = Builder
"sampler2D"
ppType (TyVec Int
n) = Builder
"vec" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
ppInt Int
n
ppType (TyMat Int
n Int
m) = Builder
"mat" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
ppInt Int
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"x" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
ppInt Int
m
ppType (TyStruct NameId
n [(Type, NameId)]
ms) =
  Builder
"uBlock" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameId -> Builder
ppNameId NameId
n
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" {\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ((Type, NameId) -> Builder) -> [(Type, NameId)] -> Builder
forall a. (a -> Builder) -> [a] -> Builder
ppL (Type, NameId) -> Builder
ppStructMember [(Type, NameId)]
ms Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}"
  where ppStructMember :: (Type, NameId) -> Builder
ppStructMember (Type
t, NameId
n) = Type -> Builder
ppType Type
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" u" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameId -> Builder
ppNameId NameId
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";\n"

newtype NameId = NameId Int
  deriving (Int -> NameId -> ShowS
[NameId] -> ShowS
NameId -> String
(Int -> NameId -> ShowS)
-> (NameId -> String) -> ([NameId] -> ShowS) -> Show NameId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameId] -> ShowS
$cshowList :: [NameId] -> ShowS
show :: NameId -> String
$cshow :: NameId -> String
showsPrec :: Int -> NameId -> ShowS
$cshowsPrec :: Int -> NameId -> ShowS
Show, NameId -> NameId -> Bool
(NameId -> NameId -> Bool)
-> (NameId -> NameId -> Bool) -> Eq NameId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameId -> NameId -> Bool
$c/= :: NameId -> NameId -> Bool
== :: NameId -> NameId -> Bool
$c== :: NameId -> NameId -> Bool
Eq)

parseNameId :: Parser NameId
parseNameId :: Parser ByteString NameId
parseNameId = Int -> NameId
NameId
  (Int -> NameId)
-> Parser ByteString Int -> Parser ByteString NameId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int
forall a. Integral a => Parser a
decimal

ppNameId :: NameId -> LTB.Builder
ppNameId :: NameId -> Builder
ppNameId (NameId Int
n) = Int -> Builder
ppInt Int
n

data Name
  = Name Namespace NameId
  deriving (Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show)

parseName :: Parser Name
parseName :: Parser ByteString Name
parseName = Namespace -> NameId -> Name
Name
  (Namespace -> NameId -> Name)
-> Parser ByteString Namespace
-> Parser ByteString (NameId -> Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Namespace
parseNamespace
  Parser ByteString (NameId -> Name)
-> Parser ByteString NameId -> Parser ByteString Name
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString NameId
parseNameId

ppName :: Name -> LTB.Builder
ppName :: Name -> Builder
ppName (Name Namespace
ns NameId
n) = Namespace -> Builder
ppNamespace Namespace
ns Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameId -> Builder
ppNameId NameId
n

data Namespace
  = NsT
  | NsS
  | NsU
  | NsVF
  | NsIn
  | NsOut
  deriving (Int -> Namespace -> ShowS
[Namespace] -> ShowS
Namespace -> String
(Int -> Namespace -> ShowS)
-> (Namespace -> String)
-> ([Namespace] -> ShowS)
-> Show Namespace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Namespace] -> ShowS
$cshowList :: [Namespace] -> ShowS
show :: Namespace -> String
$cshow :: Namespace -> String
showsPrec :: Int -> Namespace -> ShowS
$cshowsPrec :: Int -> Namespace -> ShowS
Show, Namespace -> Namespace -> Bool
(Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool) -> Eq Namespace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Namespace -> Namespace -> Bool
$c/= :: Namespace -> Namespace -> Bool
== :: Namespace -> Namespace -> Bool
$c== :: Namespace -> Namespace -> Bool
Eq)

parseNamespace :: Parser Namespace
parseNamespace :: Parser ByteString Namespace
parseNamespace =
  (Parser ByteString ByteString
"in" Parser ByteString ByteString
-> Parser ByteString Namespace -> Parser ByteString Namespace
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Namespace -> Parser ByteString Namespace
forall (f :: * -> *) a. Applicative f => a -> f a
pure Namespace
NsIn)
  Parser ByteString Namespace
-> Parser ByteString Namespace -> Parser ByteString Namespace
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"out" Parser ByteString ByteString
-> Parser ByteString Namespace -> Parser ByteString Namespace
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Namespace -> Parser ByteString Namespace
forall (f :: * -> *) a. Applicative f => a -> f a
pure Namespace
NsOut)
  Parser ByteString Namespace
-> Parser ByteString Namespace -> Parser ByteString Namespace
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"vf" Parser ByteString ByteString
-> Parser ByteString Namespace -> Parser ByteString Namespace
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Namespace -> Parser ByteString Namespace
forall (f :: * -> *) a. Applicative f => a -> f a
pure Namespace
NsVF)
  Parser ByteString Namespace
-> Parser ByteString Namespace -> Parser ByteString Namespace
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
't' Parser Char
-> Parser ByteString Namespace -> Parser ByteString Namespace
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Namespace -> Parser ByteString Namespace
forall (f :: * -> *) a. Applicative f => a -> f a
pure Namespace
NsT)
  Parser ByteString Namespace
-> Parser ByteString Namespace -> Parser ByteString Namespace
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
'u' Parser Char
-> Parser ByteString Namespace -> Parser ByteString Namespace
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Namespace -> Parser ByteString Namespace
forall (f :: * -> *) a. Applicative f => a -> f a
pure Namespace
NsU)
  Parser ByteString Namespace
-> Parser ByteString Namespace -> Parser ByteString Namespace
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
's' Parser Char
-> Parser ByteString Namespace -> Parser ByteString Namespace
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Namespace -> Parser ByteString Namespace
forall (f :: * -> *) a. Applicative f => a -> f a
pure Namespace
NsS)

ppNamespace :: Namespace -> LTB.Builder
ppNamespace :: Namespace -> Builder
ppNamespace Namespace
NsT   = Builder
"t"
ppNamespace Namespace
NsS   = Builder
"s"
ppNamespace Namespace
NsU   = Builder
"u"
ppNamespace Namespace
NsVF  = Builder
"vf"
ppNamespace Namespace
NsIn  = Builder
"in"
ppNamespace Namespace
NsOut = Builder
"out"

data FunName
  = PrimMain
  | PrimMat3x3
  | PrimMat4x4
  | PrimVec2
  | PrimVec3
  | PrimVec4
  | PrimPow
  | PrimDot
  | PrimCos
  | PrimAtan
  | PrimMod
  | PrimAbs
  | PrimCross
  | PrimLength
  | PrimAsin
  | PrimSmoothstep
  | PrimStep
  | PrimFract
  | PrimFloor
  | PrimSin
  | PrimTan
  | PrimSqrt
  | PrimNormalize
  deriving (Int -> FunName -> ShowS
[FunName] -> ShowS
FunName -> String
(Int -> FunName -> ShowS)
-> (FunName -> String) -> ([FunName] -> ShowS) -> Show FunName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunName] -> ShowS
$cshowList :: [FunName] -> ShowS
show :: FunName -> String
$cshow :: FunName -> String
showsPrec :: Int -> FunName -> ShowS
$cshowsPrec :: Int -> FunName -> ShowS
Show, FunName -> FunName -> Bool
(FunName -> FunName -> Bool)
-> (FunName -> FunName -> Bool) -> Eq FunName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunName -> FunName -> Bool
$c/= :: FunName -> FunName -> Bool
== :: FunName -> FunName -> Bool
$c== :: FunName -> FunName -> Bool
Eq)

parseFunName :: Parser FunName
parseFunName :: Parser FunName
parseFunName =
  (Parser ByteString ByteString
"main" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimMain)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"mat3x3" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimMat3x3)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"mat4x4" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimMat4x4)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"vec2" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimVec2)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"vec3" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimVec3)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"vec4" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimVec4)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"pow" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimPow)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"dot" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimDot)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"cos" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimCos)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"atan" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimAtan)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"mod" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimMod)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"abs" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimAbs)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"cross" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimCross)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"length" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimLength)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"asin" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimAsin)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"smoothstep" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimSmoothstep)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"step" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimStep)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"fract" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimFract)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"floor" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimFloor)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"sin" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimSin)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"tan" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimTan)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"sqrt" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimSqrt)
  Parser FunName -> Parser FunName -> Parser FunName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"normalize" Parser ByteString ByteString -> Parser FunName -> Parser FunName
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FunName -> Parser FunName
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunName
PrimNormalize)

ppFunName :: FunName -> LTB.Builder
ppFunName :: FunName -> Builder
ppFunName FunName
PrimMain       = Builder
"main"
ppFunName FunName
PrimMat3x3     = Builder
"mat3x3"
ppFunName FunName
PrimMat4x4     = Builder
"mat4x4"
ppFunName FunName
PrimVec2       = Builder
"vec2"
ppFunName FunName
PrimVec3       = Builder
"vec3"
ppFunName FunName
PrimVec4       = Builder
"vec4"
ppFunName FunName
PrimPow        = Builder
"pow"
ppFunName FunName
PrimDot        = Builder
"dot"
ppFunName FunName
PrimCos        = Builder
"cos"
ppFunName FunName
PrimAtan       = Builder
"atan"
ppFunName FunName
PrimMod        = Builder
"mod"
ppFunName FunName
PrimAbs        = Builder
"abs"
ppFunName FunName
PrimCross      = Builder
"cross"
ppFunName FunName
PrimLength     = Builder
"length"
ppFunName FunName
PrimAsin       = Builder
"asin"
ppFunName FunName
PrimSmoothstep = Builder
"smoothstep"
ppFunName FunName
PrimStep       = Builder
"step"
ppFunName FunName
PrimFract      = Builder
"fract"
ppFunName FunName
PrimFloor      = Builder
"floor"
ppFunName FunName
PrimSin        = Builder
"sin"
ppFunName FunName
PrimTan        = Builder
"tan"
ppFunName FunName
PrimSqrt       = Builder
"sqrt"
ppFunName FunName
PrimNormalize  = Builder
"normalize"

data Swizzle
  = X | Y | Z | W
  deriving (Int -> Swizzle -> ShowS
[Swizzle] -> ShowS
Swizzle -> String
(Int -> Swizzle -> ShowS)
-> (Swizzle -> String) -> ([Swizzle] -> ShowS) -> Show Swizzle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Swizzle] -> ShowS
$cshowList :: [Swizzle] -> ShowS
show :: Swizzle -> String
$cshow :: Swizzle -> String
showsPrec :: Int -> Swizzle -> ShowS
$cshowsPrec :: Int -> Swizzle -> ShowS
Show, Swizzle -> Swizzle -> Bool
(Swizzle -> Swizzle -> Bool)
-> (Swizzle -> Swizzle -> Bool) -> Eq Swizzle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Swizzle -> Swizzle -> Bool
$c/= :: Swizzle -> Swizzle -> Bool
== :: Swizzle -> Swizzle -> Bool
$c== :: Swizzle -> Swizzle -> Bool
Eq)

parseSwizzle :: Parser Swizzle
parseSwizzle :: Parser Swizzle
parseSwizzle =
  (Char -> Parser Char
char Char
'x' Parser Char -> Parser Swizzle -> Parser Swizzle
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Swizzle -> Parser Swizzle
forall (f :: * -> *) a. Applicative f => a -> f a
pure Swizzle
X)
  Parser Swizzle -> Parser Swizzle -> Parser Swizzle
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
'y' Parser Char -> Parser Swizzle -> Parser Swizzle
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Swizzle -> Parser Swizzle
forall (f :: * -> *) a. Applicative f => a -> f a
pure Swizzle
Y)
  Parser Swizzle -> Parser Swizzle -> Parser Swizzle
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
'z' Parser Char -> Parser Swizzle -> Parser Swizzle
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Swizzle -> Parser Swizzle
forall (f :: * -> *) a. Applicative f => a -> f a
pure Swizzle
Z)
  Parser Swizzle -> Parser Swizzle -> Parser Swizzle
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
'w' Parser Char -> Parser Swizzle -> Parser Swizzle
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Swizzle -> Parser Swizzle
forall (f :: * -> *) a. Applicative f => a -> f a
pure Swizzle
W)

ppSwizzle :: Swizzle -> LTB.Builder
ppSwizzle :: Swizzle -> Builder
ppSwizzle Swizzle
X = Builder
"x"
ppSwizzle Swizzle
Y = Builder
"y"
ppSwizzle Swizzle
Z = Builder
"z"
ppSwizzle Swizzle
W = Builder
"w"

parseVecIndex :: Parser Swizzle
parseVecIndex :: Parser Swizzle
parseVecIndex =
  (Char -> Parser Char
char Char
'0' Parser Char -> Parser Swizzle -> Parser Swizzle
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Swizzle -> Parser Swizzle
forall (f :: * -> *) a. Applicative f => a -> f a
pure Swizzle
X)
  Parser Swizzle -> Parser Swizzle -> Parser Swizzle
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
'1' Parser Char -> Parser Swizzle -> Parser Swizzle
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Swizzle -> Parser Swizzle
forall (f :: * -> *) a. Applicative f => a -> f a
pure Swizzle
Y)
  Parser Swizzle -> Parser Swizzle -> Parser Swizzle
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
'2' Parser Char -> Parser Swizzle -> Parser Swizzle
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Swizzle -> Parser Swizzle
forall (f :: * -> *) a. Applicative f => a -> f a
pure Swizzle
Z)
  Parser Swizzle -> Parser Swizzle -> Parser Swizzle
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
'3' Parser Char -> Parser Swizzle -> Parser Swizzle
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Swizzle -> Parser Swizzle
forall (f :: * -> *) a. Applicative f => a -> f a
pure Swizzle
W)

ppVecIndex :: Swizzle -> LTB.Builder
ppVecIndex :: Swizzle -> Builder
ppVecIndex Swizzle
X = Builder
"0"
ppVecIndex Swizzle
Y = Builder
"1"
ppVecIndex Swizzle
Z = Builder
"2"
ppVecIndex Swizzle
W = Builder
"3"

data NameExpr
  = NameExpr Name
  | UniformExpr NameId NameId
  deriving (Int -> NameExpr -> ShowS
[NameExpr] -> ShowS
NameExpr -> String
(Int -> NameExpr -> ShowS)
-> (NameExpr -> String) -> ([NameExpr] -> ShowS) -> Show NameExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameExpr] -> ShowS
$cshowList :: [NameExpr] -> ShowS
show :: NameExpr -> String
$cshow :: NameExpr -> String
showsPrec :: Int -> NameExpr -> ShowS
$cshowsPrec :: Int -> NameExpr -> ShowS
Show)

parseNameExpr :: Parser NameExpr
parseNameExpr :: Parser NameExpr
parseNameExpr =
  NameId -> NameId -> NameExpr
UniformExpr (NameId -> NameId -> NameExpr)
-> Parser ByteString NameId
-> Parser ByteString (NameId -> NameExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
char Char
'u' Parser Char -> Parser ByteString NameId -> Parser ByteString NameId
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString NameId
parseNameId) Parser ByteString (NameId -> NameExpr)
-> Parser ByteString NameId -> Parser NameExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
".u" Parser ByteString ByteString
-> Parser ByteString NameId -> Parser ByteString NameId
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString NameId
parseNameId)
  Parser NameExpr -> Parser NameExpr -> Parser NameExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Name -> NameExpr
NameExpr (Name -> NameExpr) -> Parser ByteString Name -> Parser NameExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Name
parseName

ppNameExpr :: NameExpr -> LTB.Builder
ppNameExpr :: NameExpr -> Builder
ppNameExpr (NameExpr Name
n) = Name -> Builder
ppName Name
n
ppNameExpr (UniformExpr NameId
n NameId
m) = Builder
"u" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameId -> Builder
ppNameId NameId
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".u" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameId -> Builder
ppNameId NameId
m

data Cast
  = Cast
  | NoCast
  deriving (Int -> Cast -> ShowS
[Cast] -> ShowS
Cast -> String
(Int -> Cast -> ShowS)
-> (Cast -> String) -> ([Cast] -> ShowS) -> Show Cast
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cast] -> ShowS
$cshowList :: [Cast] -> ShowS
show :: Cast -> String
$cshow :: Cast -> String
showsPrec :: Int -> Cast -> ShowS
$cshowsPrec :: Int -> Cast -> ShowS
Show)

data ExprAtom
  = LitIntExpr Cast Int
  | LitFloatExpr Cast Float
  | IdentifierExpr NameExpr
  | SwizzleExpr NameId Swizzle
  | VecIndexExpr NameExpr Swizzle
  | MatIndexExpr NameExpr Swizzle Swizzle
  deriving (Int -> ExprAtom -> ShowS
[ExprAtom] -> ShowS
ExprAtom -> String
(Int -> ExprAtom -> ShowS)
-> (ExprAtom -> String) -> ([ExprAtom] -> ShowS) -> Show ExprAtom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExprAtom] -> ShowS
$cshowList :: [ExprAtom] -> ShowS
show :: ExprAtom -> String
$cshow :: ExprAtom -> String
showsPrec :: Int -> ExprAtom -> ShowS
$cshowsPrec :: Int -> ExprAtom -> ShowS
Show)

parseExprAtom :: Parser ExprAtom
parseExprAtom :: Parser ExprAtom
parseExprAtom =
  Scientific -> ExprAtom
litNumber (Scientific -> ExprAtom)
-> Parser ByteString Scientific -> Parser ExprAtom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Scientific
scientific
  Parser ExprAtom -> Parser ExprAtom -> Parser ExprAtom
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Cast -> Int -> ExprAtom
LitIntExpr Cast
Cast (Int -> ExprAtom) -> Parser ByteString Int -> Parser ExprAtom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
"int(" Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString Int
forall a. Integral a => Parser a
decimal Parser ByteString Int
-> (Int -> Parser ByteString Int) -> Parser ByteString Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Parser ByteString ByteString
")" Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser ByteString Int -> Parser ByteString Int)
-> (Int -> Parser ByteString Int) -> Int -> Parser ByteString Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Parser ByteString Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  Parser ExprAtom -> Parser ExprAtom -> Parser ExprAtom
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Cast -> Float -> ExprAtom
LitFloatExpr Cast
Cast (Float -> ExprAtom) -> Parser ByteString Float -> Parser ExprAtom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
"float(" Parser ByteString ByteString
-> Parser ByteString Float -> Parser ByteString Float
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString Float
forall a. Fractional a => Parser a
rational Parser ByteString Float
-> (Float -> Parser ByteString Float) -> Parser ByteString Float
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Parser ByteString ByteString
")" Parser ByteString ByteString
-> Parser ByteString Float -> Parser ByteString Float
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser ByteString Float -> Parser ByteString Float)
-> (Float -> Parser ByteString Float)
-> Float
-> Parser ByteString Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Parser ByteString Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  Parser ExprAtom -> Parser ExprAtom -> Parser ExprAtom
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NameId -> Swizzle -> ExprAtom
SwizzleExpr (NameId -> Swizzle -> ExprAtom)
-> Parser ByteString NameId
-> Parser ByteString (Swizzle -> ExprAtom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
char Char
't' Parser Char -> Parser ByteString NameId -> Parser ByteString NameId
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString NameId
parseNameId) Parser ByteString (Swizzle -> ExprAtom)
-> Parser Swizzle -> Parser ExprAtom
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser Char
char Char
'.' Parser Char -> Parser Swizzle -> Parser Swizzle
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Swizzle
parseSwizzle)
  Parser ExprAtom -> Parser ExprAtom -> Parser ExprAtom
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NameExpr -> Swizzle -> Swizzle -> ExprAtom
MatIndexExpr (NameExpr -> Swizzle -> Swizzle -> ExprAtom)
-> Parser NameExpr
-> Parser ByteString (Swizzle -> Swizzle -> ExprAtom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser NameExpr
parseNameExpr Parser ByteString (Swizzle -> Swizzle -> ExprAtom)
-> Parser Swizzle -> Parser ByteString (Swizzle -> ExprAtom)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
"[" Parser ByteString ByteString -> Parser Swizzle -> Parser Swizzle
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Swizzle
parseVecIndex) Parser ByteString (Swizzle -> ExprAtom)
-> Parser Swizzle -> Parser ExprAtom
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
"][" Parser ByteString ByteString -> Parser Swizzle -> Parser Swizzle
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Swizzle
parseVecIndex Parser Swizzle -> (Swizzle -> Parser Swizzle) -> Parser Swizzle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Parser ByteString ByteString
"]" Parser ByteString ByteString -> Parser Swizzle -> Parser Swizzle
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser Swizzle -> Parser Swizzle)
-> (Swizzle -> Parser Swizzle) -> Swizzle -> Parser Swizzle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Swizzle -> Parser Swizzle
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  Parser ExprAtom -> Parser ExprAtom -> Parser ExprAtom
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NameExpr -> Swizzle -> ExprAtom
VecIndexExpr (NameExpr -> Swizzle -> ExprAtom)
-> Parser NameExpr -> Parser ByteString (Swizzle -> ExprAtom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser NameExpr
parseNameExpr Parser ByteString (Swizzle -> ExprAtom)
-> Parser Swizzle -> Parser ExprAtom
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
"[" Parser ByteString ByteString -> Parser Swizzle -> Parser Swizzle
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Swizzle
parseVecIndex Parser Swizzle -> (Swizzle -> Parser Swizzle) -> Parser Swizzle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Parser ByteString ByteString
"]" Parser ByteString ByteString -> Parser Swizzle -> Parser Swizzle
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser Swizzle -> Parser Swizzle)
-> (Swizzle -> Parser Swizzle) -> Swizzle -> Parser Swizzle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Swizzle -> Parser Swizzle
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  Parser ExprAtom -> Parser ExprAtom -> Parser ExprAtom
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NameExpr -> ExprAtom
IdentifierExpr (NameExpr -> ExprAtom) -> Parser NameExpr -> Parser ExprAtom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser NameExpr
parseNameExpr
  where
    litNumber :: Scientific -> ExprAtom
litNumber Scientific
s =
      let e :: Int
e = Scientific -> Int
Sci.base10Exponent Scientific
s
          c :: Integer
c = Scientific -> Integer
Sci.coefficient Scientific
s
      in if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
          then Cast -> Int -> ExprAtom
LitIntExpr Cast
NoCast (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer
c Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
e))
          else Cast -> Float -> ExprAtom
LitFloatExpr Cast
NoCast (Scientific -> Float
forall a. RealFloat a => Scientific -> a
Sci.toRealFloat Scientific
s)

ppExprAtom :: ExprAtom -> LTB.Builder
ppExprAtom :: ExprAtom -> Builder
ppExprAtom (LitIntExpr Cast
Cast Int
i)     = Builder
"int(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
ppInt Int
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
ppExprAtom (LitIntExpr Cast
NoCast Int
i)   = Int -> Builder
ppInt Int
i
ppExprAtom (LitFloatExpr Cast
Cast Float
n)   = Builder
"float(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Float -> Builder
ppFloat Float
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
ppExprAtom (LitFloatExpr Cast
NoCast Float
r) = Float -> Builder
ppFloat Float
r
ppExprAtom (IdentifierExpr NameExpr
n)      = NameExpr -> Builder
ppNameExpr NameExpr
n
ppExprAtom (SwizzleExpr NameId
n Swizzle
m)       = Builder
"t" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameId -> Builder
ppNameId NameId
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Swizzle -> Builder
ppSwizzle Swizzle
m
ppExprAtom (VecIndexExpr NameExpr
n Swizzle
i)      = NameExpr -> Builder
ppNameExpr NameExpr
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Swizzle -> Builder
ppVecIndex Swizzle
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]"
ppExprAtom (MatIndexExpr NameExpr
n Swizzle
i Swizzle
j)    = NameExpr -> Builder
ppNameExpr NameExpr
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Swizzle -> Builder
ppVecIndex Swizzle
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Swizzle -> Builder
ppVecIndex Swizzle
j Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]"

data Expr
  = UnaryExpr UnaryOp ExprAtom
  | BinaryExpr ExprAtom BinaryOp ExprAtom
  | FunCallExpr FunName [ExprAtom]
  | TextureExpr ExprAtom ExprAtom ExprAtom
  | AtomExpr ExprAtom
  deriving (Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> String
(Int -> Expr -> ShowS)
-> (Expr -> String) -> ([Expr] -> ShowS) -> Show Expr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expr] -> ShowS
$cshowList :: [Expr] -> ShowS
show :: Expr -> String
$cshow :: Expr -> String
showsPrec :: Int -> Expr -> ShowS
$cshowsPrec :: Int -> Expr -> ShowS
Show)

parseExpr :: Parser Expr
parseExpr :: Parser ByteString Expr
parseExpr =
  (Char -> Parser Char
char Char
'(' Parser Char -> Parser ByteString Expr -> Parser ByteString Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString Expr
operatorExpr Parser ByteString Expr
-> (Expr -> Parser ByteString Expr) -> Parser ByteString Expr
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Char -> Parser Char
char Char
')' Parser Char -> Parser ByteString Expr -> Parser ByteString Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser ByteString Expr -> Parser ByteString Expr)
-> (Expr -> Parser ByteString Expr)
-> Expr
-> Parser ByteString Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Parser ByteString Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  Parser ByteString Expr
-> Parser ByteString Expr -> Parser ByteString Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Expr
textureExpr
  Parser ByteString Expr
-> Parser ByteString Expr -> Parser ByteString Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Expr
funCallExpr
  Parser ByteString Expr
-> Parser ByteString Expr -> Parser ByteString Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ExprAtom -> Expr
AtomExpr (ExprAtom -> Expr) -> Parser ExprAtom -> Parser ByteString Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ExprAtom
parseExprAtom

  where
    operatorExpr :: Parser ByteString Expr
operatorExpr =
      ExprAtom -> BinaryOp -> ExprAtom -> Expr
BinaryExpr (ExprAtom -> BinaryOp -> ExprAtom -> Expr)
-> Parser ExprAtom
-> Parser ByteString (BinaryOp -> ExprAtom -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ExprAtom
parseExprAtom Parser ByteString (BinaryOp -> ExprAtom -> Expr)
-> Parser ByteString BinaryOp
-> Parser ByteString (ExprAtom -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString BinaryOp
parseBinaryOp Parser ByteString (ExprAtom -> Expr)
-> Parser ExprAtom -> Parser ByteString Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ExprAtom
parseExprAtom
      Parser ByteString Expr
-> Parser ByteString Expr -> Parser ByteString Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> UnaryOp -> ExprAtom -> Expr
UnaryExpr (UnaryOp -> ExprAtom -> Expr)
-> Parser ByteString UnaryOp
-> Parser ByteString (ExprAtom -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString UnaryOp
parseUnaryOp Parser ByteString (ExprAtom -> Expr)
-> Parser ExprAtom -> Parser ByteString Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ExprAtom
parseExprAtom

    textureExpr :: Parser ByteString Expr
textureExpr = ExprAtom -> ExprAtom -> ExprAtom -> Expr
TextureExpr
      (ExprAtom -> ExprAtom -> ExprAtom -> Expr)
-> Parser ExprAtom
-> Parser ByteString (ExprAtom -> ExprAtom -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
"texture(" Parser ByteString ByteString -> Parser ExprAtom -> Parser ExprAtom
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ExprAtom
parseExprAtom)
      Parser ByteString (ExprAtom -> ExprAtom -> Expr)
-> Parser ExprAtom -> Parser ByteString (ExprAtom -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
",vec2(" Parser ByteString ByteString -> Parser ExprAtom -> Parser ExprAtom
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ExprAtom
parseExprAtom)
      Parser ByteString (ExprAtom -> Expr)
-> Parser ExprAtom -> Parser ByteString Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
"," Parser ByteString ByteString -> Parser ExprAtom -> Parser ExprAtom
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ExprAtom
parseExprAtom Parser ExprAtom -> (ExprAtom -> Parser ExprAtom) -> Parser ExprAtom
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Parser ByteString ByteString
"))" Parser ByteString ByteString -> Parser ExprAtom -> Parser ExprAtom
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser ExprAtom -> Parser ExprAtom)
-> (ExprAtom -> Parser ExprAtom) -> ExprAtom -> Parser ExprAtom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprAtom -> Parser ExprAtom
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

    funCallExpr :: Parser ByteString Expr
funCallExpr = FunName -> [ExprAtom] -> Expr
FunCallExpr
      (FunName -> [ExprAtom] -> Expr)
-> Parser FunName -> Parser ByteString ([ExprAtom] -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FunName
parseFunName
      Parser ByteString ([ExprAtom] -> Expr)
-> Parser ByteString [ExprAtom] -> Parser ByteString Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser Char
char Char
'(' Parser Char
-> Parser ByteString [ExprAtom] -> Parser ByteString [ExprAtom]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ExprAtom -> Parser Char -> Parser ByteString [ExprAtom]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy1 Parser ExprAtom
parseExprAtom (Char -> Parser Char
char Char
',') Parser ByteString [ExprAtom]
-> ([ExprAtom] -> Parser ByteString [ExprAtom])
-> Parser ByteString [ExprAtom]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Char -> Parser Char
char Char
')' Parser Char
-> Parser ByteString [ExprAtom] -> Parser ByteString [ExprAtom]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser ByteString [ExprAtom] -> Parser ByteString [ExprAtom])
-> ([ExprAtom] -> Parser ByteString [ExprAtom])
-> [ExprAtom]
-> Parser ByteString [ExprAtom]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ExprAtom] -> Parser ByteString [ExprAtom]
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

ppExpr :: Expr -> LTB.Builder
ppExpr :: Expr -> Builder
ppExpr (AtomExpr ExprAtom
e) = ExprAtom -> Builder
ppExprAtom ExprAtom
e
ppExpr (UnaryExpr UnaryOp
o ExprAtom
e) = Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> UnaryOp -> Builder
ppUnaryOp UnaryOp
o Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ExprAtom -> Builder
ppExprAtom ExprAtom
e Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
ppExpr (BinaryExpr ExprAtom
l BinaryOp
o ExprAtom
r) = Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ExprAtom -> Builder
ppExprAtom ExprAtom
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> BinaryOp -> Builder
ppBinaryOp BinaryOp
o Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ExprAtom -> Builder
ppExprAtom ExprAtom
r Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
ppExpr (FunCallExpr FunName
n [ExprAtom]
args) = FunName -> Builder
ppFunName FunName
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> (ExprAtom -> Builder) -> [ExprAtom] -> Builder
forall a. Builder -> (a -> Builder) -> [a] -> Builder
ppS Builder
"," ExprAtom -> Builder
ppExprAtom [ExprAtom]
args Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
ppExpr (TextureExpr ExprAtom
t ExprAtom
x ExprAtom
y) = Builder
"texture(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ExprAtom -> Builder
ppExprAtom ExprAtom
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
",vec2(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ExprAtom -> Builder
ppExprAtom ExprAtom
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"," Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ExprAtom -> Builder
ppExprAtom ExprAtom
y Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"))"

data BinaryOp
  = BOpPlus
  | BOpMinus
  | BOpMul
  | BOpDiv
  | BOpGE
  | BOpGT
  | BOpLE
  | BOpLT
  | BOpAnd
  | BOpOr
  deriving (Int -> BinaryOp -> ShowS
[BinaryOp] -> ShowS
BinaryOp -> String
(Int -> BinaryOp -> ShowS)
-> (BinaryOp -> String) -> ([BinaryOp] -> ShowS) -> Show BinaryOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinaryOp] -> ShowS
$cshowList :: [BinaryOp] -> ShowS
show :: BinaryOp -> String
$cshow :: BinaryOp -> String
showsPrec :: Int -> BinaryOp -> ShowS
$cshowsPrec :: Int -> BinaryOp -> ShowS
Show, BinaryOp -> BinaryOp -> Bool
(BinaryOp -> BinaryOp -> Bool)
-> (BinaryOp -> BinaryOp -> Bool) -> Eq BinaryOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinaryOp -> BinaryOp -> Bool
$c/= :: BinaryOp -> BinaryOp -> Bool
== :: BinaryOp -> BinaryOp -> Bool
$c== :: BinaryOp -> BinaryOp -> Bool
Eq)

parseBinaryOp :: Parser BinaryOp
parseBinaryOp :: Parser ByteString BinaryOp
parseBinaryOp =
  (Char -> Parser Char
char Char
'+' Parser Char
-> Parser ByteString BinaryOp -> Parser ByteString BinaryOp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinaryOp -> Parser ByteString BinaryOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinaryOp
BOpPlus)
  Parser ByteString BinaryOp
-> Parser ByteString BinaryOp -> Parser ByteString BinaryOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
'-' Parser Char
-> Parser ByteString BinaryOp -> Parser ByteString BinaryOp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinaryOp -> Parser ByteString BinaryOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinaryOp
BOpMinus)
  Parser ByteString BinaryOp
-> Parser ByteString BinaryOp -> Parser ByteString BinaryOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
'*' Parser Char
-> Parser ByteString BinaryOp -> Parser ByteString BinaryOp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinaryOp -> Parser ByteString BinaryOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinaryOp
BOpMul)
  Parser ByteString BinaryOp
-> Parser ByteString BinaryOp -> Parser ByteString BinaryOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
'/' Parser Char
-> Parser ByteString BinaryOp -> Parser ByteString BinaryOp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinaryOp -> Parser ByteString BinaryOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinaryOp
BOpDiv)
  Parser ByteString BinaryOp
-> Parser ByteString BinaryOp -> Parser ByteString BinaryOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
">=" Parser ByteString ByteString
-> Parser ByteString BinaryOp -> Parser ByteString BinaryOp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinaryOp -> Parser ByteString BinaryOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinaryOp
BOpGE)
  Parser ByteString BinaryOp
-> Parser ByteString BinaryOp -> Parser ByteString BinaryOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
">" Parser ByteString ByteString
-> Parser ByteString BinaryOp -> Parser ByteString BinaryOp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinaryOp -> Parser ByteString BinaryOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinaryOp
BOpGT)
  Parser ByteString BinaryOp
-> Parser ByteString BinaryOp -> Parser ByteString BinaryOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"<=" Parser ByteString ByteString
-> Parser ByteString BinaryOp -> Parser ByteString BinaryOp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinaryOp -> Parser ByteString BinaryOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinaryOp
BOpLE)
  Parser ByteString BinaryOp
-> Parser ByteString BinaryOp -> Parser ByteString BinaryOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"<" Parser ByteString ByteString
-> Parser ByteString BinaryOp -> Parser ByteString BinaryOp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinaryOp -> Parser ByteString BinaryOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinaryOp
BOpLT)
  Parser ByteString BinaryOp
-> Parser ByteString BinaryOp -> Parser ByteString BinaryOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"&&" Parser ByteString ByteString
-> Parser ByteString BinaryOp -> Parser ByteString BinaryOp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinaryOp -> Parser ByteString BinaryOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinaryOp
BOpAnd)
  Parser ByteString BinaryOp
-> Parser ByteString BinaryOp -> Parser ByteString BinaryOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"||" Parser ByteString ByteString
-> Parser ByteString BinaryOp -> Parser ByteString BinaryOp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinaryOp -> Parser ByteString BinaryOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinaryOp
BOpOr)

ppBinaryOp :: BinaryOp -> LTB.Builder
ppBinaryOp :: BinaryOp -> Builder
ppBinaryOp BinaryOp
BOpPlus  = Builder
"+"
ppBinaryOp BinaryOp
BOpMinus = Builder
"-"
ppBinaryOp BinaryOp
BOpMul   = Builder
"*"
ppBinaryOp BinaryOp
BOpDiv   = Builder
"/"
ppBinaryOp BinaryOp
BOpGE    = Builder
">="
ppBinaryOp BinaryOp
BOpGT    = Builder
">"
ppBinaryOp BinaryOp
BOpLE    = Builder
"<="
ppBinaryOp BinaryOp
BOpLT    = Builder
"<"
ppBinaryOp BinaryOp
BOpAnd   = Builder
"&&"
ppBinaryOp BinaryOp
BOpOr    = Builder
"||"

data UnaryOp
  = UOpMinus
  | UOpNot
  deriving (Int -> UnaryOp -> ShowS
[UnaryOp] -> ShowS
UnaryOp -> String
(Int -> UnaryOp -> ShowS)
-> (UnaryOp -> String) -> ([UnaryOp] -> ShowS) -> Show UnaryOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnaryOp] -> ShowS
$cshowList :: [UnaryOp] -> ShowS
show :: UnaryOp -> String
$cshow :: UnaryOp -> String
showsPrec :: Int -> UnaryOp -> ShowS
$cshowsPrec :: Int -> UnaryOp -> ShowS
Show, UnaryOp -> UnaryOp -> Bool
(UnaryOp -> UnaryOp -> Bool)
-> (UnaryOp -> UnaryOp -> Bool) -> Eq UnaryOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnaryOp -> UnaryOp -> Bool
$c/= :: UnaryOp -> UnaryOp -> Bool
== :: UnaryOp -> UnaryOp -> Bool
$c== :: UnaryOp -> UnaryOp -> Bool
Eq)

parseUnaryOp :: Parser UnaryOp
parseUnaryOp :: Parser ByteString UnaryOp
parseUnaryOp =
  (Char -> Parser Char
char Char
'-' Parser Char
-> Parser ByteString UnaryOp -> Parser ByteString UnaryOp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UnaryOp -> Parser ByteString UnaryOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnaryOp
UOpMinus)
  Parser ByteString UnaryOp
-> Parser ByteString UnaryOp -> Parser ByteString UnaryOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
'!' Parser Char
-> Parser ByteString UnaryOp -> Parser ByteString UnaryOp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UnaryOp -> Parser ByteString UnaryOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnaryOp
UOpMinus)

ppUnaryOp :: UnaryOp -> LTB.Builder
ppUnaryOp :: UnaryOp -> Builder
ppUnaryOp UnaryOp
UOpMinus = Builder
"-"
ppUnaryOp UnaryOp
UOpNot   = Builder
"!"

data StmtAnnot a = SA
  { StmtAnnot a -> a
annot   :: a
  , StmtAnnot a -> Stmt a
unAnnot :: Stmt a
  }
  deriving (Int -> StmtAnnot a -> ShowS
[StmtAnnot a] -> ShowS
StmtAnnot a -> String
(Int -> StmtAnnot a -> ShowS)
-> (StmtAnnot a -> String)
-> ([StmtAnnot a] -> ShowS)
-> Show (StmtAnnot a)
forall a. Show a => Int -> StmtAnnot a -> ShowS
forall a. Show a => [StmtAnnot a] -> ShowS
forall a. Show a => StmtAnnot a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StmtAnnot a] -> ShowS
$cshowList :: forall a. Show a => [StmtAnnot a] -> ShowS
show :: StmtAnnot a -> String
$cshow :: forall a. Show a => StmtAnnot a -> String
showsPrec :: Int -> StmtAnnot a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> StmtAnnot a -> ShowS
Show, a -> StmtAnnot b -> StmtAnnot a
(a -> b) -> StmtAnnot a -> StmtAnnot b
(forall a b. (a -> b) -> StmtAnnot a -> StmtAnnot b)
-> (forall a b. a -> StmtAnnot b -> StmtAnnot a)
-> Functor StmtAnnot
forall a b. a -> StmtAnnot b -> StmtAnnot a
forall a b. (a -> b) -> StmtAnnot a -> StmtAnnot b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> StmtAnnot b -> StmtAnnot a
$c<$ :: forall a b. a -> StmtAnnot b -> StmtAnnot a
fmap :: (a -> b) -> StmtAnnot a -> StmtAnnot b
$cfmap :: forall a b. (a -> b) -> StmtAnnot a -> StmtAnnot b
Functor, StmtAnnot a -> Bool
(a -> m) -> StmtAnnot a -> m
(a -> b -> b) -> b -> StmtAnnot a -> b
(forall m. Monoid m => StmtAnnot m -> m)
-> (forall m a. Monoid m => (a -> m) -> StmtAnnot a -> m)
-> (forall m a. Monoid m => (a -> m) -> StmtAnnot a -> m)
-> (forall a b. (a -> b -> b) -> b -> StmtAnnot a -> b)
-> (forall a b. (a -> b -> b) -> b -> StmtAnnot a -> b)
-> (forall b a. (b -> a -> b) -> b -> StmtAnnot a -> b)
-> (forall b a. (b -> a -> b) -> b -> StmtAnnot a -> b)
-> (forall a. (a -> a -> a) -> StmtAnnot a -> a)
-> (forall a. (a -> a -> a) -> StmtAnnot a -> a)
-> (forall a. StmtAnnot a -> [a])
-> (forall a. StmtAnnot a -> Bool)
-> (forall a. StmtAnnot a -> Int)
-> (forall a. Eq a => a -> StmtAnnot a -> Bool)
-> (forall a. Ord a => StmtAnnot a -> a)
-> (forall a. Ord a => StmtAnnot a -> a)
-> (forall a. Num a => StmtAnnot a -> a)
-> (forall a. Num a => StmtAnnot a -> a)
-> Foldable StmtAnnot
forall a. Eq a => a -> StmtAnnot a -> Bool
forall a. Num a => StmtAnnot a -> a
forall a. Ord a => StmtAnnot a -> a
forall m. Monoid m => StmtAnnot m -> m
forall a. StmtAnnot a -> Bool
forall a. StmtAnnot a -> Int
forall a. StmtAnnot a -> [a]
forall a. (a -> a -> a) -> StmtAnnot a -> a
forall m a. Monoid m => (a -> m) -> StmtAnnot a -> m
forall b a. (b -> a -> b) -> b -> StmtAnnot a -> b
forall a b. (a -> b -> b) -> b -> StmtAnnot a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: StmtAnnot a -> a
$cproduct :: forall a. Num a => StmtAnnot a -> a
sum :: StmtAnnot a -> a
$csum :: forall a. Num a => StmtAnnot a -> a
minimum :: StmtAnnot a -> a
$cminimum :: forall a. Ord a => StmtAnnot a -> a
maximum :: StmtAnnot a -> a
$cmaximum :: forall a. Ord a => StmtAnnot a -> a
elem :: a -> StmtAnnot a -> Bool
$celem :: forall a. Eq a => a -> StmtAnnot a -> Bool
length :: StmtAnnot a -> Int
$clength :: forall a. StmtAnnot a -> Int
null :: StmtAnnot a -> Bool
$cnull :: forall a. StmtAnnot a -> Bool
toList :: StmtAnnot a -> [a]
$ctoList :: forall a. StmtAnnot a -> [a]
foldl1 :: (a -> a -> a) -> StmtAnnot a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> StmtAnnot a -> a
foldr1 :: (a -> a -> a) -> StmtAnnot a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> StmtAnnot a -> a
foldl' :: (b -> a -> b) -> b -> StmtAnnot a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> StmtAnnot a -> b
foldl :: (b -> a -> b) -> b -> StmtAnnot a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> StmtAnnot a -> b
foldr' :: (a -> b -> b) -> b -> StmtAnnot a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> StmtAnnot a -> b
foldr :: (a -> b -> b) -> b -> StmtAnnot a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> StmtAnnot a -> b
foldMap' :: (a -> m) -> StmtAnnot a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> StmtAnnot a -> m
foldMap :: (a -> m) -> StmtAnnot a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> StmtAnnot a -> m
fold :: StmtAnnot m -> m
$cfold :: forall m. Monoid m => StmtAnnot m -> m
Foldable, Functor StmtAnnot
Foldable StmtAnnot
Functor StmtAnnot
-> Foldable StmtAnnot
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> StmtAnnot a -> f (StmtAnnot b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    StmtAnnot (f a) -> f (StmtAnnot a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> StmtAnnot a -> m (StmtAnnot b))
-> (forall (m :: * -> *) a.
    Monad m =>
    StmtAnnot (m a) -> m (StmtAnnot a))
-> Traversable StmtAnnot
(a -> f b) -> StmtAnnot a -> f (StmtAnnot b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
StmtAnnot (m a) -> m (StmtAnnot a)
forall (f :: * -> *) a.
Applicative f =>
StmtAnnot (f a) -> f (StmtAnnot a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> StmtAnnot a -> m (StmtAnnot b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StmtAnnot a -> f (StmtAnnot b)
sequence :: StmtAnnot (m a) -> m (StmtAnnot a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
StmtAnnot (m a) -> m (StmtAnnot a)
mapM :: (a -> m b) -> StmtAnnot a -> m (StmtAnnot b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> StmtAnnot a -> m (StmtAnnot b)
sequenceA :: StmtAnnot (f a) -> f (StmtAnnot a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
StmtAnnot (f a) -> f (StmtAnnot a)
traverse :: (a -> f b) -> StmtAnnot a -> f (StmtAnnot b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StmtAnnot a -> f (StmtAnnot b)
$cp2Traversable :: Foldable StmtAnnot
$cp1Traversable :: Functor StmtAnnot
Traversable)

instance Applicative StmtAnnot where
  pure :: a -> StmtAnnot a
pure a
a = a -> Stmt a -> StmtAnnot a
forall a. a -> Stmt a -> StmtAnnot a
SA a
a (a -> Stmt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
  liftA2 :: (a -> b -> c) -> StmtAnnot a -> StmtAnnot b -> StmtAnnot c
liftA2 a -> b -> c
f StmtAnnot a
a StmtAnnot b
b = c -> Stmt c -> StmtAnnot c
forall a. a -> Stmt a -> StmtAnnot a
SA (a -> b -> c
f (StmtAnnot a -> a
forall a. StmtAnnot a -> a
annot StmtAnnot a
a) (StmtAnnot b -> b
forall a. StmtAnnot a -> a
annot StmtAnnot b
b)) (Stmt c -> StmtAnnot c) -> Stmt c -> StmtAnnot c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c) -> Stmt a -> Stmt b -> Stmt c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f (StmtAnnot a -> Stmt a
forall a. StmtAnnot a -> Stmt a
unAnnot StmtAnnot a
a) (StmtAnnot b -> Stmt b
forall a. StmtAnnot a -> Stmt a
unAnnot StmtAnnot b
b)

parseStmtAnnot :: Annot a => Parser (StmtAnnot a)
parseStmtAnnot :: Parser (StmtAnnot a)
parseStmtAnnot = a -> Stmt a -> StmtAnnot a
forall a. a -> Stmt a -> StmtAnnot a
SA (a -> Stmt a -> StmtAnnot a)
-> Parser ByteString a -> Parser ByteString (Stmt a -> StmtAnnot a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString a
forall a. Annot a => Parser a
parseAnnot Parser ByteString (Stmt a -> StmtAnnot a)
-> Parser ByteString (Stmt a) -> Parser (StmtAnnot a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Stmt a)
forall a. Annot a => Parser (Stmt a)
parseStmt

ppStmtAnnot :: Annot a => StmtAnnot a -> LTB.Builder
ppStmtAnnot :: StmtAnnot a -> Builder
ppStmtAnnot (SA a
a Stmt a
s) =
  Builder -> (Builder -> Builder) -> Maybe Builder -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" (\Builder
ltb -> Builder
"// " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
ltb Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n") (a -> Maybe Builder
forall a. Annot a => a -> Maybe Builder
ppAnnot a
a) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Stmt a -> Builder
forall a. Annot a => Stmt a -> Builder
ppStmt Stmt a
s

data Stmt a
  = AssignStmt Name Expr
  | DeclStmt LocalDecl
  | EmitStmt Emit
  | IfStmt NameId [StmtAnnot a] [StmtAnnot a]
  deriving (Int -> Stmt a -> ShowS
[Stmt a] -> ShowS
Stmt a -> String
(Int -> Stmt a -> ShowS)
-> (Stmt a -> String) -> ([Stmt a] -> ShowS) -> Show (Stmt a)
forall a. Show a => Int -> Stmt a -> ShowS
forall a. Show a => [Stmt a] -> ShowS
forall a. Show a => Stmt a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stmt a] -> ShowS
$cshowList :: forall a. Show a => [Stmt a] -> ShowS
show :: Stmt a -> String
$cshow :: forall a. Show a => Stmt a -> String
showsPrec :: Int -> Stmt a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Stmt a -> ShowS
Show, a -> Stmt b -> Stmt a
(a -> b) -> Stmt a -> Stmt b
(forall a b. (a -> b) -> Stmt a -> Stmt b)
-> (forall a b. a -> Stmt b -> Stmt a) -> Functor Stmt
forall a b. a -> Stmt b -> Stmt a
forall a b. (a -> b) -> Stmt a -> Stmt b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Stmt b -> Stmt a
$c<$ :: forall a b. a -> Stmt b -> Stmt a
fmap :: (a -> b) -> Stmt a -> Stmt b
$cfmap :: forall a b. (a -> b) -> Stmt a -> Stmt b
Functor, Stmt a -> Bool
(a -> m) -> Stmt a -> m
(a -> b -> b) -> b -> Stmt a -> b
(forall m. Monoid m => Stmt m -> m)
-> (forall m a. Monoid m => (a -> m) -> Stmt a -> m)
-> (forall m a. Monoid m => (a -> m) -> Stmt a -> m)
-> (forall a b. (a -> b -> b) -> b -> Stmt a -> b)
-> (forall a b. (a -> b -> b) -> b -> Stmt a -> b)
-> (forall b a. (b -> a -> b) -> b -> Stmt a -> b)
-> (forall b a. (b -> a -> b) -> b -> Stmt a -> b)
-> (forall a. (a -> a -> a) -> Stmt a -> a)
-> (forall a. (a -> a -> a) -> Stmt a -> a)
-> (forall a. Stmt a -> [a])
-> (forall a. Stmt a -> Bool)
-> (forall a. Stmt a -> Int)
-> (forall a. Eq a => a -> Stmt a -> Bool)
-> (forall a. Ord a => Stmt a -> a)
-> (forall a. Ord a => Stmt a -> a)
-> (forall a. Num a => Stmt a -> a)
-> (forall a. Num a => Stmt a -> a)
-> Foldable Stmt
forall a. Eq a => a -> Stmt a -> Bool
forall a. Num a => Stmt a -> a
forall a. Ord a => Stmt a -> a
forall m. Monoid m => Stmt m -> m
forall a. Stmt a -> Bool
forall a. Stmt a -> Int
forall a. Stmt a -> [a]
forall a. (a -> a -> a) -> Stmt a -> a
forall m a. Monoid m => (a -> m) -> Stmt a -> m
forall b a. (b -> a -> b) -> b -> Stmt a -> b
forall a b. (a -> b -> b) -> b -> Stmt a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Stmt a -> a
$cproduct :: forall a. Num a => Stmt a -> a
sum :: Stmt a -> a
$csum :: forall a. Num a => Stmt a -> a
minimum :: Stmt a -> a
$cminimum :: forall a. Ord a => Stmt a -> a
maximum :: Stmt a -> a
$cmaximum :: forall a. Ord a => Stmt a -> a
elem :: a -> Stmt a -> Bool
$celem :: forall a. Eq a => a -> Stmt a -> Bool
length :: Stmt a -> Int
$clength :: forall a. Stmt a -> Int
null :: Stmt a -> Bool
$cnull :: forall a. Stmt a -> Bool
toList :: Stmt a -> [a]
$ctoList :: forall a. Stmt a -> [a]
foldl1 :: (a -> a -> a) -> Stmt a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Stmt a -> a
foldr1 :: (a -> a -> a) -> Stmt a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Stmt a -> a
foldl' :: (b -> a -> b) -> b -> Stmt a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Stmt a -> b
foldl :: (b -> a -> b) -> b -> Stmt a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Stmt a -> b
foldr' :: (a -> b -> b) -> b -> Stmt a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Stmt a -> b
foldr :: (a -> b -> b) -> b -> Stmt a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Stmt a -> b
foldMap' :: (a -> m) -> Stmt a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Stmt a -> m
foldMap :: (a -> m) -> Stmt a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Stmt a -> m
fold :: Stmt m -> m
$cfold :: forall m. Monoid m => Stmt m -> m
Foldable, Functor Stmt
Foldable Stmt
Functor Stmt
-> Foldable Stmt
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Stmt a -> f (Stmt b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Stmt (f a) -> f (Stmt a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Stmt a -> m (Stmt b))
-> (forall (m :: * -> *) a. Monad m => Stmt (m a) -> m (Stmt a))
-> Traversable Stmt
(a -> f b) -> Stmt a -> f (Stmt b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Stmt (m a) -> m (Stmt a)
forall (f :: * -> *) a. Applicative f => Stmt (f a) -> f (Stmt a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stmt a -> m (Stmt b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stmt a -> f (Stmt b)
sequence :: Stmt (m a) -> m (Stmt a)
$csequence :: forall (m :: * -> *) a. Monad m => Stmt (m a) -> m (Stmt a)
mapM :: (a -> m b) -> Stmt a -> m (Stmt b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stmt a -> m (Stmt b)
sequenceA :: Stmt (f a) -> f (Stmt a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Stmt (f a) -> f (Stmt a)
traverse :: (a -> f b) -> Stmt a -> f (Stmt b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stmt a -> f (Stmt b)
$cp2Traversable :: Foldable Stmt
$cp1Traversable :: Functor Stmt
Traversable)

instance Applicative Stmt where
  -- Arbitrary decision because "pure" doesn't really make sense.
  pure :: a -> Stmt a
pure a
_ = Emit -> Stmt a
forall a. Emit -> Stmt a
EmitStmt Emit
EmitFragDepth

  liftA2 :: (a -> b -> c) -> Stmt a -> Stmt b -> Stmt c
liftA2 a -> b -> c
f (IfStmt NameId
n [StmtAnnot a]
t1 [StmtAnnot a]
e1) (IfStmt NameId
_ [StmtAnnot b]
t2 [StmtAnnot b]
e2) = NameId -> [StmtAnnot c] -> [StmtAnnot c] -> Stmt c
forall a. NameId -> [StmtAnnot a] -> [StmtAnnot a] -> Stmt a
IfStmt NameId
n
    (((StmtAnnot a -> StmtAnnot b -> StmtAnnot c)
-> [StmtAnnot a] -> [StmtAnnot b] -> [StmtAnnot c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((StmtAnnot a -> StmtAnnot b -> StmtAnnot c)
 -> [StmtAnnot a] -> [StmtAnnot b] -> [StmtAnnot c])
-> ((a -> b -> c) -> StmtAnnot a -> StmtAnnot b -> StmtAnnot c)
-> (a -> b -> c)
-> [StmtAnnot a]
-> [StmtAnnot b]
-> [StmtAnnot c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> c) -> StmtAnnot a -> StmtAnnot b -> StmtAnnot c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2) a -> b -> c
f [StmtAnnot a]
t1 [StmtAnnot b]
t2)
    (((StmtAnnot a -> StmtAnnot b -> StmtAnnot c)
-> [StmtAnnot a] -> [StmtAnnot b] -> [StmtAnnot c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((StmtAnnot a -> StmtAnnot b -> StmtAnnot c)
 -> [StmtAnnot a] -> [StmtAnnot b] -> [StmtAnnot c])
-> ((a -> b -> c) -> StmtAnnot a -> StmtAnnot b -> StmtAnnot c)
-> (a -> b -> c)
-> [StmtAnnot a]
-> [StmtAnnot b]
-> [StmtAnnot c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> c) -> StmtAnnot a -> StmtAnnot b -> StmtAnnot c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2) a -> b -> c
f [StmtAnnot a]
e1 [StmtAnnot b]
e2)
  liftA2 a -> b -> c
_ (AssignStmt Name
n Expr
e) Stmt b
_ = Name -> Expr -> Stmt c
forall a. Name -> Expr -> Stmt a
AssignStmt Name
n Expr
e
  liftA2 a -> b -> c
_ (DeclStmt LocalDecl
d) Stmt b
_ = LocalDecl -> Stmt c
forall a. LocalDecl -> Stmt a
DeclStmt LocalDecl
d
  liftA2 a -> b -> c
_ (EmitStmt Emit
e) Stmt b
_ = Emit -> Stmt c
forall a. Emit -> Stmt a
EmitStmt Emit
e
  liftA2 a -> b -> c
_ (IfStmt NameId
n [StmtAnnot a]
_ [StmtAnnot a]
_) Stmt b
_ = NameId -> [StmtAnnot c] -> [StmtAnnot c] -> Stmt c
forall a. NameId -> [StmtAnnot a] -> [StmtAnnot a] -> Stmt a
IfStmt NameId
n [] []


parseStmt :: Annot a => Parser (Stmt a)
parseStmt :: Parser (Stmt a)
parseStmt =
  NameId -> [StmtAnnot a] -> [StmtAnnot a] -> Stmt a
forall a. NameId -> [StmtAnnot a] -> [StmtAnnot a] -> Stmt a
IfStmt (NameId -> [StmtAnnot a] -> [StmtAnnot a] -> Stmt a)
-> Parser ByteString NameId
-> Parser ByteString ([StmtAnnot a] -> [StmtAnnot a] -> Stmt a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
"if(t" Parser ByteString ByteString
-> Parser ByteString NameId -> Parser ByteString NameId
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString NameId
parseNameId Parser ByteString NameId
-> (NameId -> Parser ByteString NameId) -> Parser ByteString NameId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Parser ByteString ByteString
"){\n" Parser ByteString ByteString
-> Parser ByteString NameId -> Parser ByteString NameId
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser ByteString NameId -> Parser ByteString NameId)
-> (NameId -> Parser ByteString NameId)
-> NameId
-> Parser ByteString NameId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameId -> Parser ByteString NameId
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
         Parser ByteString ([StmtAnnot a] -> [StmtAnnot a] -> Stmt a)
-> Parser ByteString [StmtAnnot a]
-> Parser ByteString ([StmtAnnot a] -> Stmt a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (StmtAnnot a) -> Parser ByteString [StmtAnnot a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser ByteString (StmtAnnot a)
forall a. Annot a => Parser (StmtAnnot a)
parseStmtAnnot
         Parser ByteString ([StmtAnnot a] -> Stmt a)
-> Parser ByteString [StmtAnnot a] -> Parser (Stmt a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
"} else {\n" Parser ByteString ByteString
-> Parser ByteString [StmtAnnot a]
-> Parser ByteString [StmtAnnot a]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString (StmtAnnot a) -> Parser ByteString [StmtAnnot a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser ByteString (StmtAnnot a)
forall a. Annot a => Parser (StmtAnnot a)
parseStmtAnnot Parser ByteString [StmtAnnot a]
-> ([StmtAnnot a] -> Parser ByteString [StmtAnnot a])
-> Parser ByteString [StmtAnnot a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Parser ByteString ByteString
"}\n" Parser ByteString ByteString
-> Parser ByteString [StmtAnnot a]
-> Parser ByteString [StmtAnnot a]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser ByteString [StmtAnnot a]
 -> Parser ByteString [StmtAnnot a])
-> ([StmtAnnot a] -> Parser ByteString [StmtAnnot a])
-> [StmtAnnot a]
-> Parser ByteString [StmtAnnot a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StmtAnnot a] -> Parser ByteString [StmtAnnot a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  Parser (Stmt a) -> Parser (Stmt a) -> Parser (Stmt a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Name -> Expr -> Stmt a
forall a. Name -> Expr -> Stmt a
AssignStmt (Name -> Expr -> Stmt a)
-> Parser ByteString Name -> Parser ByteString (Expr -> Stmt a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Name
parseName Parser ByteString (Expr -> Stmt a)
-> Parser ByteString Expr -> Parser (Stmt a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" = " Parser ByteString ByteString
-> Parser ByteString Expr -> Parser ByteString Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString Expr
parseExpr Parser ByteString Expr
-> (Expr -> Parser ByteString Expr) -> Parser ByteString Expr
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Parser ByteString ByteString
";\n" Parser ByteString ByteString
-> Parser ByteString Expr -> Parser ByteString Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser ByteString Expr -> Parser ByteString Expr)
-> (Expr -> Parser ByteString Expr)
-> Expr
-> Parser ByteString Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Parser ByteString Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  Parser (Stmt a) -> Parser (Stmt a) -> Parser (Stmt a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LocalDecl -> Stmt a
forall a. LocalDecl -> Stmt a
DeclStmt (LocalDecl -> Stmt a)
-> Parser ByteString LocalDecl -> Parser (Stmt a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString LocalDecl
parseLocalDecl
  Parser (Stmt a) -> Parser (Stmt a) -> Parser (Stmt a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Emit -> Stmt a
forall a. Emit -> Stmt a
EmitStmt (Emit -> Stmt a) -> Parser ByteString Emit -> Parser (Stmt a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Emit
parseEmit

ppStmt :: Annot a => Stmt a -> LTB.Builder
ppStmt :: Stmt a -> Builder
ppStmt (AssignStmt Name
n Expr
e) = Name -> Builder
ppName Name
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" = " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Expr -> Builder
ppExpr Expr
e Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";\n"
ppStmt (DeclStmt LocalDecl
d) = LocalDecl -> Builder
ppLocalDecl LocalDecl
d
ppStmt (EmitStmt Emit
e) = Emit -> Builder
ppEmit Emit
e
ppStmt (IfStmt NameId
c [StmtAnnot a]
t [StmtAnnot a]
e) =
  Builder
"if(t" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameId -> Builder
ppNameId NameId
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"){\n"
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (StmtAnnot a -> Builder) -> [StmtAnnot a] -> Builder
forall a. (a -> Builder) -> [a] -> Builder
ppL StmtAnnot a -> Builder
forall a. Annot a => StmtAnnot a -> Builder
ppStmtAnnot [StmtAnnot a]
t
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"} else {\n"
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (StmtAnnot a -> Builder) -> [StmtAnnot a] -> Builder
forall a. (a -> Builder) -> [a] -> Builder
ppL StmtAnnot a -> Builder
forall a. Annot a => StmtAnnot a -> Builder
ppStmtAnnot [StmtAnnot a]
e
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}\n"

data Emit
  = EmitPosition Expr
  | EmitFragDepth
  deriving (Int -> Emit -> ShowS
[Emit] -> ShowS
Emit -> String
(Int -> Emit -> ShowS)
-> (Emit -> String) -> ([Emit] -> ShowS) -> Show Emit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Emit] -> ShowS
$cshowList :: [Emit] -> ShowS
show :: Emit -> String
$cshow :: Emit -> String
showsPrec :: Int -> Emit -> ShowS
$cshowsPrec :: Int -> Emit -> ShowS
Show)

parseEmit :: Parser Emit
parseEmit :: Parser ByteString Emit
parseEmit =
  Expr -> Emit
EmitPosition (Expr -> Emit) -> Parser ByteString Expr -> Parser ByteString Emit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
"gl_Position = " Parser ByteString ByteString
-> Parser ByteString Expr -> Parser ByteString Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString Expr
parseExpr Parser ByteString Expr
-> (Expr -> Parser ByteString Expr) -> Parser ByteString Expr
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Parser ByteString ByteString
";\n" Parser ByteString ByteString
-> Parser ByteString Expr -> Parser ByteString Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser ByteString Expr -> Parser ByteString Expr)
-> (Expr -> Parser ByteString Expr)
-> Expr
-> Parser ByteString Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Parser ByteString Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  Parser ByteString Emit
-> Parser ByteString Emit -> Parser ByteString Emit
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"gl_FragDepth = gl_FragCoord[2];\n" Parser ByteString ByteString
-> Parser ByteString Emit -> Parser ByteString Emit
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Emit -> Parser ByteString Emit
forall (f :: * -> *) a. Applicative f => a -> f a
pure Emit
EmitFragDepth)

ppEmit :: Emit -> LTB.Builder
ppEmit :: Emit -> Builder
ppEmit (EmitPosition Expr
e) = Builder
"gl_Position = " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Expr -> Builder
ppExpr Expr
e Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";\n"
ppEmit Emit
EmitFragDepth    = Builder
"gl_FragDepth = gl_FragCoord[2];\n"

ppInt :: Int -> LTB.Builder
ppInt :: Int -> Builder
ppInt = Int -> Builder
forall a. Integral a => a -> Builder
LTB.decimal

ppFloat :: Float -> LTB.Builder
ppFloat :: Float -> Builder
ppFloat = Float -> Builder
forall a. RealFloat a => a -> Builder
LTB.realFloat

ppL :: (a -> LTB.Builder) -> [a] -> LTB.Builder
ppL :: (a -> Builder) -> [a] -> Builder
ppL a -> Builder
printer = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> ([a] -> [Builder]) -> [a] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Builder) -> [a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map a -> Builder
printer

ppS :: LTB.Builder -> (a -> LTB.Builder) -> [a] -> LTB.Builder
ppS :: Builder -> (a -> Builder) -> [a] -> Builder
ppS Builder
sep a -> Builder
printer = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> ([a] -> [Builder]) -> [a] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
sep ([Builder] -> [Builder]) -> ([a] -> [Builder]) -> [a] -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Builder) -> [a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map a -> Builder
printer

class Annot a where
  parseAnnot :: Parser a
  ppAnnot :: a -> Maybe LTB.Builder

instance Annot () where
  parseAnnot :: Parser ByteString ()
parseAnnot = () -> Parser ByteString ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  ppAnnot :: () -> Maybe Builder
ppAnnot = Maybe Builder -> () -> Maybe Builder
forall a b. a -> b -> a
const Maybe Builder
forall a. Maybe a
Nothing

instance (Annot a, Annot b) => Annot (a, b) where
  parseAnnot :: Parser (a, b)
parseAnnot = String -> Parser (a, b)
forall a. HasCallStack => String -> a
error String
"not implemented"
  ppAnnot :: (a, b) -> Maybe Builder
ppAnnot (a
a, b
b) = do
    Builder
ppA <- a -> Maybe Builder
forall a. Annot a => a -> Maybe Builder
ppAnnot a
a
    Builder
ppB <- b -> Maybe Builder
forall a. Annot a => a -> Maybe Builder
ppAnnot b
b
    Builder -> Maybe Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$ Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
ppA Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
", " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
ppB Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"

----------------------------------

parseTest :: Show a => Parser a -> LT.Text -> IO ()
parseTest :: Parser a -> Text -> IO ()
parseTest Parser a
p Text
input =
  let r :: String
r = IResult ByteString a -> String
forall a. Show a => a -> String
show (IResult ByteString a -> String)
-> (Text -> IResult ByteString a) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IResult ByteString a -> IResult ByteString a
forall i r. Monoid i => IResult i r -> IResult i r
fromPartial (IResult ByteString a -> IResult ByteString a)
-> (Text -> IResult ByteString a) -> Text -> IResult ByteString a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> ByteString -> IResult ByteString a
forall a. Parser a -> ByteString -> Result a
parse Parser a
p (ByteString -> IResult ByteString a)
-> (Text -> ByteString) -> Text -> IResult ByteString a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
input in
  if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
600
    then
      let start :: String
start = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
500 String
r
          end :: String
end = ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
100 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
reverse String
r
      in
      String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
start String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" ... " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
end
    else String -> IO ()
putStrLn String
r
  where
    fromPartial :: IResult i r -> IResult i r
fromPartial (Partial i -> IResult i r
cont) = i -> IResult i r
cont i
forall a. Monoid a => a
mempty
    fromPartial IResult i r
r              = IResult i r
r

t :: Show a => Parser a -> String -> IO ()
t :: Parser a -> String -> IO ()
t Parser a
p = Parser a -> Text -> IO ()
forall a. Show a => Parser a -> Text -> IO ()
parseTest Parser a
p (Text -> IO ()) -> (String -> Text) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
LT.pack

pp :: (a -> LTB.Builder) -> a -> String
pp :: (a -> Builder) -> a -> String
pp a -> Builder
printer = Text -> String
LT.unpack (Text -> String) -> (a -> Text) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LTB.toLazyText (Builder -> Text) -> (a -> Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
printer

ppl :: (a -> LTB.Builder) -> [a] -> String
ppl :: (a -> Builder) -> [a] -> String
ppl a -> Builder
printer = Text -> String
LT.unpack (Text -> String) -> ([a] -> Text) -> [a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LTB.toLazyText (Builder -> Text) -> ([a] -> Builder) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Builder) -> [a] -> Builder
forall a. (a -> Builder) -> [a] -> Builder
ppL a -> Builder
printer