diff --git a/primer/primer.cabal b/primer/primer.cabal index ff05fc13a..9d9d5164d 100644 --- a/primer/primer.cabal +++ b/primer/primer.cabal @@ -113,8 +113,6 @@ library , base64-bytestring ^>=1.2.1 , containers >=0.6.0.1 && <0.7.0 , deriving-aeson >=0.2 && <0.3.0 - , diagrams-lib ^>=1.4.6 - , diagrams-rasterific ^>=1.4.2 , exceptions >=0.10.4 && <0.11.0 , extra >=1.7.10 && <1.8.0 , generic-optics >=2.0 && <2.3.0 @@ -273,7 +271,6 @@ test-suite primer-test , aeson , aeson-pretty ^>=0.8.9 , base - , base64-bytestring , bytestring , containers , extra diff --git a/primer/src/Primer/Primitives.hs b/primer/src/Primer/Primitives.hs index a456a23ad..d3bc5670d 100644 --- a/primer/src/Primer/Primitives.hs +++ b/primer/src/Primer/Primitives.hs @@ -28,41 +28,10 @@ module Primer.Primitives ( import Foreword hiding (rotate) -import Codec.Picture.ColorQuant (palettizeWithAlpha) -import Codec.Picture.Gif ( - GifDisposalMethod (DisposalRestoreBackground), - GifEncode (GifEncode), - GifLooping (LoopingForever), - encodeComplexGifImage, - ) import Control.Monad.Fresh (MonadFresh) import Data.Aeson (FromJSON (..), ToJSON (..)) -import Data.ByteString.Base64 qualified as B64 import Data.Data (Data) import Data.Map qualified as M -import Diagrams.Backend.Rasterific ( - Options (RasterificOptions), - Rasterific (Rasterific), - ) -import Diagrams.Prelude ( - Diagram, - V2 (..), - black, - circle, - deg, - fillColor, - lineWidth, - mkP2, - mkSizeSpec, - recommendFillColor, - rect, - rectEnvelope, - renderDia, - rotate, - sRGB24, - translate, - (@@), - ) import Numeric.Natural (Natural) import Primer.Builtins ( cCons, @@ -94,7 +63,6 @@ import Primer.Core.DSL ( ann, char, int, - prim, tcon, ) import Primer.Core.Utils (generateIDs) @@ -353,35 +321,16 @@ primFunDef def args = case def of -- Since we only support translating a `Picture` expression to an image once it is in normal form, -- this guard will only pass when `picture` has no free variables other than `time`. [PrimCon () (PrimInt duration), Lam () time picture] - | Just (frames :: [Diagram Rasterific]) <- traverse diagramAtTime [0 .. (duration * 100) `div` frameLength - 1] -> - Right - $ prim - $ PrimAnimation - $ either - -- This case really shouldn't be able to happen, unless `diagrams-rasterific` is broken. - -- In fact, the default behaviour (`animatedGif`) is just to write the error to `stdout`, - -- and we only have to handle this because we need to use the lower-level `rasterGif`, - -- for unrelated reasons (getting the `Bytestring` without dumping it to a file). - mempty - (decodeUtf8 . B64.encode . toS) - $ encodeComplexGifImage - $ GifEncode (fromInteger width) (fromInteger height) Nothing Nothing gifLooping - $ flip palettizeWithAlpha DisposalRestoreBackground - $ map - ( (fromInteger frameLength,) - . renderDia - Rasterific - (RasterificOptions (mkSizeSpec $ Just . fromInteger <$> V2 width height)) - . rectEnvelope - (fromInteger <$> mkP2 (-width `div` 2) (-height `div` 2)) - (fromInteger <$> V2 width height) - ) - frames + | Just _frames <- traverse diagramAtTime [0 .. (duration * 100) `div` frameLength - 1] -> + -- temporarily disabled due to dependency issues with WASM + -- we keep around as much as we can without `diagrams` (relies on `fsnotify`, and uses Template Haskell), + -- or `Rasterific` (relies on `bitvec`, which fails on WASM with GHC <9.8) + err where -- Note that this simple substitution hack only allows for trivial functions, -- i.e. those where only substitution is needed for the function body to reach a normal form. -- Our primitives system doesn't yet support further evaluation here. - diagramAtTime t = exprToDiagram $ substTime (PrimCon () (PrimInt t)) picture + diagramAtTime t = exprToPicture $ substTime (PrimCon () (PrimInt t)) picture where substTime a = \case Var () (LocalVarRef t') | t' == time -> a @@ -389,10 +338,10 @@ primFunDef def args = case def of e -> e -- Values which are hardcoded, for now at least, for the sake of keeping the student-facing API simple. -- We keep the frame rate and resolution low to avoid serialising huge GIFs. - gifLooping = LoopingForever + -- gifLooping = LoopingForever frameLength = 10 -- in hundredths of a second, as per the GIF spec - width = 160 - height = 90 + _width :: Int = 160 + _height :: Int = 90 _ -> err PrimConst -> case args of [x, _] -> @@ -403,17 +352,6 @@ primFunDef def args = case def of Con _ c [] | c == cZero -> Just 0 Con _ c [x] | c == cSucc -> succ <$> exprToNat x _ -> Nothing - exprToDiagram e = - exprToPicture e <&> recommendFillColor black . fix \f -> \case - Circle r -> - if r == 0 -- `diagrams` crashes with a divide-by-zero if we don't catch this case - then mempty - else circle (fromInteger r) & lineWidth 0 - Rect w h -> rect (fromInteger w) (fromInteger h) & lineWidth 0 - Colour r g b p -> f p & fillColor (sRGB24 (fromInteger r) (fromInteger g) (fromInteger b)) - Rotate a p -> f p & rotate (fromInteger a @@ deg) - Translate x y p -> f p & translate (V2 (fromInteger x) (fromInteger y)) - CompoundPicture ps -> foldMap' f ps err = Left $ PrimFunError def args pictureDef :: ASTTypeDef () () diff --git a/primer/test/Tests/EvalFull.hs b/primer/test/Tests/EvalFull.hs index 2767f7dd8..7a51080e1 100644 --- a/primer/test/Tests/EvalFull.hs +++ b/primer/test/Tests/EvalFull.hs @@ -1,10 +1,7 @@ -{-# LANGUAGE ViewPatterns #-} - module Tests.EvalFull where import Foreword hiding (unlines) -import Data.ByteString.Base64 qualified as B64 import Data.List ((\\)) import Data.List.NonEmpty qualified as NE import Data.Map qualified as M @@ -63,12 +60,10 @@ import Primer.Module ( builtinModule, builtinTypes, moduleDefsQualified, - moduleTypesQualified, primitiveModule, ) import Primer.Primitives ( PrimDef ( - Animate, EqChar, HexToNat, IntAdd, @@ -91,12 +86,6 @@ import Primer.Primitives ( PrimConst, ToUpper ), - cCircle, - cColour, - cCompoundPicture, - cRectangle, - cRotate, - cTranslate, tChar, tInt, ) @@ -132,14 +121,11 @@ import Tasty ( withDiscards, withTests, ) -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.Golden (goldenVsString) import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, (@?=)) import Tests.Action.Prog (readerToState) import Tests.Eval.Utils (genDirTm, hasHoles, hasTypeLets, testModules, (~=)) import Tests.Gen.Core.Typed (checkTest) import Tests.Typecheck (runTypecheckTestM, runTypecheckTestMWithPrims) -import Prelude (error) unit_1 :: Assertion unit_1 = @@ -1904,92 +1890,6 @@ unit_case_prim = s4 <- evalFullTest maxID4 mempty mempty 6 Syn e4 s4 <~==> Right expect4 -test_animation :: TestTree -test_animation = - testGroup - "animation" - $ zip - [(1 :: Int) ..] - [ pfun Animate - `app` int 1 - `app` lam - "t" - ( con - cColour - [ int 0 - , int 255 - , int 0 - , con1 cCircle (int 30) - ] - ) - , pfun Animate - `app` int 5 - `app` lam - "t" - ( con1 - cCompoundPicture - $ list_ - [ con - cColour - [ int 80 - , int 180 - , int 230 - , con - cTranslate - [ int (-35) - , int 0 - , con1 cCompoundPicture - $ list_ - [ con - cTranslate - [ int 7 - , int 7 - , con - cRotate - [ int (-45) - , con - cTranslate - [ int 0 - , int (-25) - , con cRectangle [int 20, int 50] - ] - ] - ] - , con - cRotate - [ int 45 - , con cRectangle [int 20, int 80] - ] - ] - ] - ] - , con - cColour - [ int 180 - , int 0 - , int 0 - , con - cTranslate - [ int 35 - , int 0 - , con1 cCircle $ lvar "t" - ] - ] - ] - ) - ] - <&> \(n, expr) -> - goldenVsString (show n) ("test/outputs/eval/animation/" <> show n <> ".gif") - $ evalFullTest 0 types defs 10 Syn (create' expr) - <&> \case - Right (PrimCon _ (PrimAnimation (B64.decode . encodeUtf8 -> Right t))) -> toS t - e -> error $ show e - where - builtins = create' builtinModule - prims = create' primitiveModule - types = moduleTypesQualified builtins <> moduleTypesQualified prims - defs = moduleDefsQualified builtins <> moduleDefsQualified prims - -- * Utilities evalFullTest' :: diff --git a/primer/test/outputs/eval/animation/1.gif b/primer/test/outputs/eval/animation/1.gif deleted file mode 100644 index 534df5ee5..000000000 Binary files a/primer/test/outputs/eval/animation/1.gif and /dev/null differ diff --git a/primer/test/outputs/eval/animation/2.gif b/primer/test/outputs/eval/animation/2.gif deleted file mode 100644 index e92378997..000000000 Binary files a/primer/test/outputs/eval/animation/2.gif and /dev/null differ