From 1f4226a77b244d78a955536c7c163a79fd7238b8 Mon Sep 17 00:00:00 2001
From: Alexey Kuleshevich <alexey@kuleshevi.ch>
Date: Thu, 18 Jun 2020 14:21:22 +0300
Subject: [PATCH] Add more instances fo ihaskell

---
 hip/src/Graphics/Image/Internal.hs       |  2 +-
 ihaskell-hip/src/IHaskell/Display/Hip.hs | 20 ++++++++++++++++++++
 2 files changed, 21 insertions(+), 1 deletion(-)

diff --git a/hip/src/Graphics/Image/Internal.hs b/hip/src/Graphics/Image/Internal.hs
index 44a95ed..3df974a 100644
--- 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
index d29bfb0..2a7dad2 100644
--- 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]