vulkan-utils 0.1.2.1 → 0.1.3

raw patch · 7 files changed

+307/−23 lines, 7 filesdep +doctestdep +vulkan-utilsdep ~basebuild-type:Customsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: doctest, vulkan-utils

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Setup.hs +6/−2
• changelog.md +4/−0
• package.yaml +18/−1
• src/Vulkan/Utils/ShaderQQ.hs +83/−16
• src/Vulkan/Utils/ShaderQQ/Interpolate.hs +161/−0
• test/doctest/Doctests.hs +10/−0
• vulkan-utils.cabal +25/−4

@@ -1,2 +1,6 @@-import Distribution.Simple-main = defaultMain+module Main where++import Distribution.Extra.Doctest (defaultMainWithDoctests)++main :: IO ()+main = defaultMainWithDoctests "doctests"

@@ -2,6 +2,10 @@  ## WIP +## [0.1.3] - 2020-11-12++- Add `glsl` interpolating quasiquoter+ ## [0.1.2.1] - 2020-11-01  - Raise bound on base

@@ -1,5 +1,5 @@ name: vulkan-utils-version: "0.1.2.1"+version: "0.1.3" synopsis: Utils for the vulkan package category: Graphics maintainer: Joe Hermaszewski <live.long.and.prosper@monoid.al>@@ -23,6 +23,23 @@     - temporary     - typed-process     - vulkan++tests:+  doctests:+    main: Doctests.hs+    other-modules: ""+    source-dirs:+      - test/doctest+    dependencies:+      - base+      - doctest+      - vulkan-utils++custom-setup:+  dependencies:+    - base+    - Cabal+    - cabal-doctest >= 1 && <1.1  default-extensions:   - AllowAmbiguousTypes

@@ -1,5 +1,6 @@ module Vulkan.Utils.ShaderQQ-  ( comp+  ( glsl+  , comp   , frag   , geom   , tesc@@ -25,41 +26,93 @@ import           System.FilePath import           System.IO.Temp import           System.Process.Typed+import           Vulkan.Utils.ShaderQQ.Interpolate --- | QuasiQuoter for creating a compute shader+-- $setup+-- >>> :set -XQuasiQuotes++-- | 'glsl' is a QuasiQuoter which produces GLSL source code with @#line@+-- directives inserted so that error locations point to the correct location in+-- the Haskell source file. It also permits basic string interpolation.+--+-- - Interpolated variables are prefixed with @$@+-- - They can optionally be surrounded with braces like @${foo}@+-- - Interpolated variables are converted to strings with 'show'+-- - To escape a @$@ use @\\$@+--+-- It is intended to be used in concert with 'compileShaderQ' like so+--+-- @+-- myConstant = 3.141 -- Note that this will have to be in a different module+-- myFragmentShader = $(compileShaderQ "frag" [glsl|+--   #version 450+--   const float myConstant = ${myConstant};+--   main (){+--   }+-- |])+-- @+--+-- An explicit example (@<interactive>@ is from doctest):+--+-- >>> let version = 450 :: Int in [glsl|#version $version|]+-- "#version 450\n#extension GL_GOOGLE_cpp_style_line_directive : enable\n#line 32 \"<interactive>\"\n"+--+-- Note that line number will be thrown off if any of the interpolated+-- variables contain newlines.+glsl :: QuasiQuoter+glsl = (badQQ "glsl")+  { quoteExp = \s -> do+                 loc <- location+                 -- Insert the directive here, `compileShaderQ` will insert+                 -- another one, but it's before this one, so who cares.+                 let codeWithLineDirective = insertLineDirective s loc+                 interpExp codeWithLineDirective+  }++-- | QuasiQuoter for creating a compute shader.+--+-- Equivalent to calling @$(compileShaderQ "comp" [glsl|...|])@ without+-- interpolation support. comp :: QuasiQuoter comp = shaderQQ "comp" --- | QuasiQuoter for creating a fragment shader+-- | QuasiQuoter for creating a fragment shader.+--+-- Equivalent to calling @$(compileShaderQ "frag" [glsl|...|])@ without+-- interpolation support. frag :: QuasiQuoter frag = shaderQQ "frag" --- | QuasiQuoter for creating a geometry shader+-- | QuasiQuoter for creating a geometry shader.+--+-- Equivalent to calling @$(compileShaderQ "geom" [glsl|...|])@ without+-- interpolation support. geom :: QuasiQuoter geom = shaderQQ "geom" --- | QuasiQuoter for creating a tessellation control shader+-- | QuasiQuoter for creating a tessellation control shader.+--+-- Equivalent to calling @$(compileShaderQ "tesc" [glsl|...|])@ without+-- interpolation support. tesc :: QuasiQuoter tesc = shaderQQ "tesc" --- | QuasiQuoter for creating a tessellation evaluation shader+-- | QuasiQuoter for creating a tessellation evaluation shader.+--+-- Equivalent to calling @$(compileShaderQ "tese" [glsl|...|])@ without+-- interpolation support. tese :: QuasiQuoter tese = shaderQQ "tese" --- | QuasiQuoter for creating a vertex shader+-- | QuasiQuoter for creating a vertex shader.+--+-- Equivalent to calling @$(compileShaderQ "vert" [glsl|...|])@ without+-- interpolation support. vert :: QuasiQuoter vert = shaderQQ "vert"  shaderQQ :: String -> QuasiQuoter-shaderQQ stage = QuasiQuoter-  { quoteExp  = compileShaderQ stage-  , quotePat  = bad "pattern"-  , quoteType = bad "type"-  , quoteDec  = bad "declaration"-  }- where-  bad :: String -> a-  bad s = error $ "Can't use " <> stage <> " quote in a " <> s <> " context"+shaderQQ stage = (badQQ stage) { quoteExp = compileShaderQ stage }  -- | Compile a glsl shader to spir-v using glslangValidator. --@@ -152,3 +205,17 @@   in  case afterVersion of         []     -> code         v : xs -> unlines $ beforeVersion <> [v] <> lineDirective <> xs++----------------------------------------------------------------+-- Utils+----------------------------------------------------------------++badQQ :: String -> QuasiQuoter+badQQ name = QuasiQuoter (bad "expression")+                         (bad "pattern")+                         (bad "type")+                         (bad "declaration")+ where+  bad :: String -> a+  bad context =+    error $ "Can't use " <> name <> " quote in a " <> context <> " context"

@@ -0,0 +1,161 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE QuasiQuotes #-}++module Vulkan.Utils.ShaderQQ.Interpolate+  ( interpExp+  ) where++import           Control.Applicative            ( liftA2 )+import           Data.Char+import           Language.Haskell.TH+import           Text.ParserCombinators.ReadP++-- $setup+-- >>> :set -XTemplateHaskell+-- >>> import Data.Proxy++-- | 'interpExp' performs very simple interpolation of Haskell+-- values into 'String's.+--+-- - Interpolated variables are prefixed with @$@+-- - They can optionally be surrounded with braces like @${foo}@+-- - Interpolated variables are converted to strings with 'show'+-- - To escape a @$@ use @\\$@+--+-- >>> let foo = 123 in $(interpExp "hello, $foo")+-- "hello, 123"+--+-- >>> let foo = "world" in $(interpExp "hello, \\$foo")+-- "hello, $foo"+--+-- >>> let foo = "world" in $(interpExp "hello\r\n\rworld")+-- "hello\r\n\rworld"+interpExp :: String -> Q Exp+interpExp =+  foldEither (litE (stringL ""))+             (appE (varE 'show) . varOrConE)+             (litE . stringL)+             (\e1 e2 -> [|$e1 <> $e2|])+    . parse++----------------------------------------------------------------+-- The parser+----------------------------------------------------------------++type Var = String++-- | Extract variables and literals from string to be interpolated+--+-- >>> parse ""+-- []+--+-- >>> parse "hello $world"+-- [Right "hello ",Left "world"]+--+-- >>> parse "$hello$world"+-- [Left "hello",Left "world"]+--+-- >>> parse "$"+-- [Right "$"]+--+-- >>> parse "hi"+-- [Right "hi"]+--+-- >>> parse "h$hi"+-- [Right "h",Left "hi"]+--+-- >>> parse "$$hi"+-- [Right "$",Left "hi"]+--+-- >>> parse "$1"+-- [Right "$1"]+--+-- >>> parse "$$$"+-- [Right "$$$"]+--+-- >>> parse "\\"+-- [Right "\\"]+--+-- >>> parse "\\$"+-- [Right "$"]+--+-- >>> parse "\\$hi"+-- [Right "$hi"]+--+-- >>> parse "\\\\$hi"+-- [Right "\\$hi"]+--+-- >>> parse "\\hi"+-- [Right "\\hi"]+--+-- >>> parse "$hi\\$foo"+-- [Left "hi",Right "$foo"]+--+-- >>> parse "hello, \\$foo"+-- [Right "hello, $foo"]+--+-- >>> parse "${fo'o}bar"+-- [Left "fo'o",Right "bar"]+--+-- >>> parse "\\"+-- [Right "\\"]+--+-- >>> parse "\\\\$"+-- [Right "\\$"]+--+-- >>> parse "$"+-- [Right "$"]+parse :: String -> [Either Var String]+parse s =+  let -- A haskell var or con+    ident = (:) <$> satisfy (isLower <||> isUpper <||> (== '_')) <*> munch+      (isAlphaNum <||> (== '\'') <||> (== '_'))+    braces = between (char '{') (char '}')+    -- parse a var, a '$' followed by an ident+    var =+      char '$' *> ((Left <$> (ident +++ braces ident)) <++ pure (Right "$"))+    -- Everything up to a '$' or '\'+    normal = Right <$> munch1 ((/= '$') <&&> (/= '\\'))+    -- escape a $+    escape = char '\\' *> (Right <$> (string "$" <++ pure "\\"))+    -- One normal or var+    -- - Check escaped '$' first+    -- - variables, starting with $+    -- - normal string+    one    = normal +++ var +++ escape+    parser = many one <* eof+  in+    case readP_to_S parser s of+      [(r, "")] -> foldr mergeRights [] r+      _         -> error "Failed to parse string"++mergeRights :: Either Var String -> [Either Var String] -> [Either Var String]+mergeRights = \case+  Left  v -> (Left v :)+  Right n -> \case+    (Right m : xs) -> Right (n <> m) : xs+    xs             -> Right n : xs++(<&&>), (<||>) :: Applicative f => f Bool -> f Bool -> f Bool+(<||>) = liftA2 (||)+(<&&>) = liftA2 (&&)++----------------------------------------------------------------+-- Misc utilities+----------------------------------------------------------------++varOrConE :: String -> ExpQ+varOrConE n = (if isLower (head n) then varE else conE) . mkName $ n++foldEither+  :: (Foldable t, Functor t)+  => c+  -> (a -> c)+  -> (b -> c)+  -> (c -> c -> c)+  -> t (Either a b)+  -> c+foldEither i l r f = foldr f i . fmap (either l r)

@@ -0,0 +1,10 @@+module Main where++import           Build_doctests                 ( flags+                                                , module_sources+                                                , pkgs+                                                )+import           Test.DocTest                   ( doctest )++main :: IO ()+main = doctest $ flags ++ pkgs ++ module_sources

@@ -1,13 +1,13 @@-cabal-version: 1.12+cabal-version: 1.24  -- This file has been generated from package.yaml by hpack version 0.34.2. -- -- see: https://github.com/sol/hpack ----- hash: 02cd419c730d93f7db6f291f1fac9c67d943c8c7a6d2be902231c4c693a58d51+-- hash: 6d99c3af4fa07ab496a943502da39d9e6a6a8d08636c91bcee01195c4a2149d3  name:           vulkan-utils-version:        0.1.2.1+version:        0.1.3 synopsis:       Utils for the vulkan package category:       Graphics homepage:       https://github.com/expipiplus1/vulkan#readme@@ -15,7 +15,7 @@ maintainer:     Joe Hermaszewski <live.long.and.prosper@monoid.al> license:        BSD3 license-file:   LICENSE-build-type:     Simple+build-type:     Custom extra-source-files:     readme.md     changelog.md@@ -26,11 +26,18 @@   type: git   location: https://github.com/expipiplus1/vulkan +custom-setup+  setup-depends:+      Cabal+    , base+    , cabal-doctest >=1 && <1.1+ library   exposed-modules:       Vulkan.Utils.Debug       Vulkan.Utils.FromGL       Vulkan.Utils.ShaderQQ+      Vulkan.Utils.ShaderQQ.Interpolate   other-modules:       Paths_vulkan_utils   hs-source-dirs:@@ -48,4 +55,18 @@     , temporary     , typed-process     , vulkan+  default-language: Haskell2010++test-suite doctests+  type: exitcode-stdio-1.0+  main-is: Doctests.hs+  other-modules:+      +  hs-source-dirs:+      test/doctest+  default-extensions: AllowAmbiguousTypes CPP DataKinds DefaultSignatures DeriveAnyClass DerivingStrategies DuplicateRecordFields FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving InstanceSigs LambdaCase MagicHash NoMonomorphismRestriction OverloadedStrings PartialTypeSignatures PatternSynonyms PolyKinds QuantifiedConstraints RankNTypes RecordWildCards RoleAnnotations ScopedTypeVariables StandaloneDeriving Strict TypeApplications TypeFamilyDependencies TypeOperators TypeSynonymInstances UndecidableInstances ViewPatterns+  build-depends:+      base+    , doctest+    , vulkan-utils   default-language: Haskell2010