Add more instances fo ihaskell

lehins · Jun 18, 2020 · 1f4226a · 1f4226a
1 parent 2596b79
commit 1f4226a
Show file tree

Hide file tree

Showing 2 changed files with 21 additions and 1 deletion.
diff --git a/hip/src/Graphics/Image/Internal.hs b/hip/src/Graphics/Image/Internal.hs
@@ -63,7 +63,7 @@ import Graphics.Pixel.ColorSpace hiding (Vector, MVector)
 import Prelude as P hiding (map, traverse, zipWith, zipWith3)
 
 -- | Main data type of the library
-data Image cs e = Image !(Array A.S Ix2 (Pixel cs e))
+data Image cs e = Image { unImage :: !(Array A.S Ix2 (Pixel cs e)) }
 -- It is not a newtype, just so the fusion works properly
 
 instance ColorModel cs e => Show (Image cs e) where

diff --git a/ihaskell-hip/src/IHaskell/Display/Hip.hs b/ihaskell-hip/src/IHaskell/Display/Hip.hs
@@ -55,6 +55,16 @@ instance {-# OVERLAPPABLE #-} (M.ColorSpace cs i e, M.ColorSpace (M.BaseSpace cs
   display = base64encode png (M.Auto M.PNG)
 
 
+instance IHaskellDisplay (NonEmpty (M.GifDelay, I.Image M.Y' Word8)) where
+  display = base64encodeSequence
+
+instance IHaskellDisplay (NonEmpty (M.GifDelay, I.Image (M.SRGB 'I.NonLinear) Word8)) where
+  display = base64encodeSequence
+
+instance IHaskellDisplay (NonEmpty (M.GifDelay, I.Image (M.Alpha (M.SRGB 'I.NonLinear)) Word8)) where
+  display = base64encodeSequence
+
+
 
 base64encode ::
      (M.Writable f (M.Image I.S cs e), M.ColorModel cs e)
@@ -66,3 +76,13 @@ base64encode toDisplayData format img@(I.Image arr) = do
   let I.Sz2 m n = I.dims img
   bs <- M.encodeM format def arr
   pure $ Display [toDisplayData n m $ base64 $ toStrict bs]
+
+
+base64encodeSequence ::
+     (M.Writable (M.Sequence M.GIF) (NonEmpty (M.GifDelay, M.Image I.S cs e)), M.ColorModel cs e)
+  => (NonEmpty (M.GifDelay, I.Image cs e))
+  -> IO Display
+base64encodeSequence imgs@((_, img) :| _) = do
+  let I.Sz2 m n = I.dims img
+  bs <- M.encodeM (M.Sequence M.GIF) def $ fmap (fmap I.unImage) imgs
+  pure $ Display [gif n m $ base64 $ toStrict bs]