From c710b3c713cd120fa7c936aa626e62dfb41b3928 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 13:14:56 -0700 Subject: [PATCH 01/14] Move PatchOutput into Renderer. --- app/DiffOutput.hs | 4 ++-- semantic-diff.cabal | 2 +- src/{ => Renderer}/PatchOutput.hs | 2 +- test/CorpusSpec.hs | 4 ++-- test/PatchOutputSpec.hs | 2 +- 5 files changed, 7 insertions(+), 7 deletions(-) rename src/{ => Renderer}/PatchOutput.hs (99%) diff --git a/app/DiffOutput.hs b/app/DiffOutput.hs index ee55cd9d2..317e41a04 100644 --- a/app/DiffOutput.hs +++ b/app/DiffOutput.hs @@ -10,7 +10,7 @@ import System.Directory import System.FilePath import qualified System.IO as IO import qualified Data.Text.Lazy.IO as TextIO -import qualified PatchOutput +import qualified Renderer.PatchOutput as PO import Rainbow -- | The available types of diff rendering. @@ -35,4 +35,4 @@ printDiff parser arguments sources = case format arguments of then path (takeFileName outputPath -<.> ".html") else path IO.withFile outputPath IO.WriteMode (flip TextIO.hPutStr rendered) - Patch -> putStr =<< diffFiles parser PatchOutput.patch sources + Patch -> putStr =<< diffFiles parser PO.patch sources diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 3e6d67bee..c140d167f 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -24,7 +24,7 @@ library , Row , Data.OrderedMap , Patch - , PatchOutput + , Renderer.PatchOutput , SES , Category , Term diff --git a/src/PatchOutput.hs b/src/Renderer/PatchOutput.hs similarity index 99% rename from src/PatchOutput.hs rename to src/Renderer/PatchOutput.hs index aa6c0e553..b30cff248 100644 --- a/src/PatchOutput.hs +++ b/src/Renderer/PatchOutput.hs @@ -1,4 +1,4 @@ -module PatchOutput ( +module Renderer.PatchOutput ( patch, hunks ) where diff --git a/test/CorpusSpec.hs b/test/CorpusSpec.hs index afbeaa133..6a7cdeac5 100644 --- a/test/CorpusSpec.hs +++ b/test/CorpusSpec.hs @@ -1,7 +1,7 @@ module CorpusSpec where import Diffing -import PatchOutput +import qualified Renderer.PatchOutput as PO import Renderer import Split import Unified @@ -43,7 +43,7 @@ spec = parallel $ do correctTests paths@(_, _, Nothing, Nothing, Nothing) = testsForPaths paths correctTests paths = List.filter (\(_, _, _, _, output) -> isJust output) $ testsForPaths paths testsForPaths :: (FilePath, FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath) -> [(String, Renderer a String, FilePath, FilePath, Maybe FilePath)] - testsForPaths (a, b, patch, split, unified) = [ ("patch", PatchOutput.patch, a, b, patch), ("split", testSplit, a, b, split), ("unified", testUnified, a, b, unified) ] + testsForPaths (a, b, patch, split, unified) = [ ("patch", PO.patch, a, b, patch), ("split", testSplit, a, b, split), ("unified", testUnified, a, b, unified) ] testSplit :: Renderer a String testSplit diff sources = TL.unpack $ Split.split diff sources testUnified :: Renderer a String diff --git a/test/PatchOutputSpec.hs b/test/PatchOutputSpec.hs index ab756f267..91cabe001 100644 --- a/test/PatchOutputSpec.hs +++ b/test/PatchOutputSpec.hs @@ -1,7 +1,7 @@ module PatchOutputSpec where import Diff -import PatchOutput +import Renderer.PatchOutput import Range import Source import Syntax From f44455c372f6be5dcc48be02850f6a91af99e020 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 13:20:25 -0700 Subject: [PATCH 02/14] Rename Renderer.PatchOutput to Renderer.Patch. --- app/DiffOutput.hs | 4 ++-- semantic-diff.cabal | 2 +- src/Renderer/{PatchOutput.hs => Patch.hs} | 2 +- test/CorpusSpec.hs | 4 ++-- test/PatchOutputSpec.hs | 2 +- 5 files changed, 7 insertions(+), 7 deletions(-) rename src/Renderer/{PatchOutput.hs => Patch.hs} (99%) diff --git a/app/DiffOutput.hs b/app/DiffOutput.hs index 317e41a04..f1d7bfff4 100644 --- a/app/DiffOutput.hs +++ b/app/DiffOutput.hs @@ -10,7 +10,7 @@ import System.Directory import System.FilePath import qualified System.IO as IO import qualified Data.Text.Lazy.IO as TextIO -import qualified Renderer.PatchOutput as PO +import qualified Renderer.Patch as P import Rainbow -- | The available types of diff rendering. @@ -35,4 +35,4 @@ printDiff parser arguments sources = case format arguments of then path (takeFileName outputPath -<.> ".html") else path IO.withFile outputPath IO.WriteMode (flip TextIO.hPutStr rendered) - Patch -> putStr =<< diffFiles parser PO.patch sources + Patch -> putStr =<< diffFiles parser P.patch sources diff --git a/semantic-diff.cabal b/semantic-diff.cabal index c140d167f..2ab5261b3 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -24,7 +24,7 @@ library , Row , Data.OrderedMap , Patch - , Renderer.PatchOutput + , Renderer.Patch , SES , Category , Term diff --git a/src/Renderer/PatchOutput.hs b/src/Renderer/Patch.hs similarity index 99% rename from src/Renderer/PatchOutput.hs rename to src/Renderer/Patch.hs index b30cff248..7b710a339 100644 --- a/src/Renderer/PatchOutput.hs +++ b/src/Renderer/Patch.hs @@ -1,4 +1,4 @@ -module Renderer.PatchOutput ( +module Renderer.Patch ( patch, hunks ) where diff --git a/test/CorpusSpec.hs b/test/CorpusSpec.hs index 6a7cdeac5..28072ad29 100644 --- a/test/CorpusSpec.hs +++ b/test/CorpusSpec.hs @@ -1,7 +1,7 @@ module CorpusSpec where import Diffing -import qualified Renderer.PatchOutput as PO +import qualified Renderer.Patch as P import Renderer import Split import Unified @@ -43,7 +43,7 @@ spec = parallel $ do correctTests paths@(_, _, Nothing, Nothing, Nothing) = testsForPaths paths correctTests paths = List.filter (\(_, _, _, _, output) -> isJust output) $ testsForPaths paths testsForPaths :: (FilePath, FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath) -> [(String, Renderer a String, FilePath, FilePath, Maybe FilePath)] - testsForPaths (a, b, patch, split, unified) = [ ("patch", PO.patch, a, b, patch), ("split", testSplit, a, b, split), ("unified", testUnified, a, b, unified) ] + testsForPaths (a, b, patch, split, unified) = [ ("patch", P.patch, a, b, patch), ("split", testSplit, a, b, split), ("unified", testUnified, a, b, unified) ] testSplit :: Renderer a String testSplit diff sources = TL.unpack $ Split.split diff sources testUnified :: Renderer a String diff --git a/test/PatchOutputSpec.hs b/test/PatchOutputSpec.hs index 91cabe001..56bd424f3 100644 --- a/test/PatchOutputSpec.hs +++ b/test/PatchOutputSpec.hs @@ -1,7 +1,7 @@ module PatchOutputSpec where import Diff -import Renderer.PatchOutput +import Renderer.Patch import Range import Source import Syntax From f8214a987229598fb1773973f1481d3c7dc4d1fb Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 13:32:39 -0700 Subject: [PATCH 03/14] Move Split under Renderer. --- app/DiffOutput.hs | 4 ++-- semantic-diff.cabal | 2 +- src/Renderer/Patch.hs | 2 +- src/{ => Renderer}/Split.hs | 2 +- test/CorpusSpec.hs | 4 ++-- test/SplitSpec.hs | 2 +- 6 files changed, 8 insertions(+), 8 deletions(-) rename src/{ => Renderer}/Split.hs (99%) diff --git a/app/DiffOutput.hs b/app/DiffOutput.hs index f1d7bfff4..cf1ab3df9 100644 --- a/app/DiffOutput.hs +++ b/app/DiffOutput.hs @@ -4,13 +4,13 @@ import Diffing import qualified Data.ByteString.Char8 as B1 import Parser import Source -import Split import Unified import System.Directory import System.FilePath import qualified System.IO as IO import qualified Data.Text.Lazy.IO as TextIO import qualified Renderer.Patch as P +import Renderer.Split import Rainbow -- | The available types of diff rendering. @@ -34,5 +34,5 @@ printDiff parser arguments sources = case format arguments of let outputPath = if isDir then path (takeFileName outputPath -<.> ".html") else path - IO.withFile outputPath IO.WriteMode (flip TextIO.hPutStr rendered) + IO.withFile outputPath IO.WriteMode (`TextIO.hPutStr` rendered) Patch -> putStr =<< diffFiles parser P.patch sources diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 2ab5261b3..36d469851 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -25,11 +25,11 @@ library , Data.OrderedMap , Patch , Renderer.Patch + , Renderer.Split , SES , Category , Term , Range - , Split , Unified , Parser , Renderer diff --git a/src/Renderer/Patch.hs b/src/Renderer/Patch.hs index 7b710a339..ba245ddf6 100644 --- a/src/Renderer/Patch.hs +++ b/src/Renderer/Patch.hs @@ -9,7 +9,7 @@ import Range import Renderer import Row import Source hiding ((++), break) -import Split +import Renderer.Split import Control.Comonad.Cofree import Control.Monad.Free import Data.Maybe diff --git a/src/Split.hs b/src/Renderer/Split.hs similarity index 99% rename from src/Split.hs rename to src/Renderer/Split.hs index d95821140..1df203d92 100644 --- a/src/Split.hs +++ b/src/Renderer/Split.hs @@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} -module Split where +module Renderer.Split where import Prelude hiding (div, head, span) import Category diff --git a/test/CorpusSpec.hs b/test/CorpusSpec.hs index 28072ad29..22bf46911 100644 --- a/test/CorpusSpec.hs +++ b/test/CorpusSpec.hs @@ -1,9 +1,9 @@ module CorpusSpec where import Diffing -import qualified Renderer.Patch as P import Renderer -import Split +import qualified Renderer.Patch as P +import qualified Renderer.Split as Split import Unified import qualified Source as S diff --git a/test/SplitSpec.hs b/test/SplitSpec.hs index 6c752c1f2..79604ed30 100644 --- a/test/SplitSpec.hs +++ b/test/SplitSpec.hs @@ -14,7 +14,7 @@ import Source hiding ((++)) import Line import Row import Range -import Split +import Renderer.Split import Syntax import ArbitraryTerm () From fcd85712748067a932007c5e7f6f6759d86e5c92 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 13:50:35 -0700 Subject: [PATCH 04/14] Move Unified under Renderer. --- app/DiffOutput.hs | 2 +- semantic-diff.cabal | 2 +- src/{ => Renderer}/Unified.hs | 2 +- test/CorpusSpec.hs | 4 ++-- 4 files changed, 5 insertions(+), 5 deletions(-) rename src/{ => Renderer}/Unified.hs (98%) diff --git a/app/DiffOutput.hs b/app/DiffOutput.hs index cf1ab3df9..a3565bcda 100644 --- a/app/DiffOutput.hs +++ b/app/DiffOutput.hs @@ -4,13 +4,13 @@ import Diffing import qualified Data.ByteString.Char8 as B1 import Parser import Source -import Unified import System.Directory import System.FilePath import qualified System.IO as IO import qualified Data.Text.Lazy.IO as TextIO import qualified Renderer.Patch as P import Renderer.Split +import Renderer.Unified import Rainbow -- | The available types of diff rendering. diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 36d469851..a141a0cc5 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -26,11 +26,11 @@ library , Patch , Renderer.Patch , Renderer.Split + , Renderer.Unified , SES , Category , Term , Range - , Unified , Parser , Renderer , TreeSitter diff --git a/src/Unified.hs b/src/Renderer/Unified.hs similarity index 98% rename from src/Unified.hs rename to src/Renderer/Unified.hs index 73f1aba23..824706c40 100644 --- a/src/Unified.hs +++ b/src/Renderer/Unified.hs @@ -1,4 +1,4 @@ -module Unified (unified, substring) where +module Renderer.Unified (unified, substring) where import Diff import Patch diff --git a/test/CorpusSpec.hs b/test/CorpusSpec.hs index 22bf46911..9e79fcd81 100644 --- a/test/CorpusSpec.hs +++ b/test/CorpusSpec.hs @@ -4,7 +4,7 @@ import Diffing import Renderer import qualified Renderer.Patch as P import qualified Renderer.Split as Split -import Unified +import qualified Renderer.Unified as Unified import qualified Source as S import Control.DeepSeq @@ -47,7 +47,7 @@ spec = parallel $ do testSplit :: Renderer a String testSplit diff sources = TL.unpack $ Split.split diff sources testUnified :: Renderer a String - testUnified diff sources = B1.unpack $ mconcat $ chunksToByteStrings toByteStringsColors0 $ unified diff sources + testUnified diff sources = B1.unpack $ mconcat $ chunksToByteStrings toByteStringsColors0 $ Unified.unified diff sources -- | Return all the examples from the given directory. Examples are expected to From 78f8704b13017aa8f4fd3ca9828599f8c29b33ec Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Feb 2016 13:55:28 -0700 Subject: [PATCH 05/14] Move Renderer up. --- semantic-diff.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-diff.cabal b/semantic-diff.cabal index a141a0cc5..3346291ee 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -24,6 +24,7 @@ library , Row , Data.OrderedMap , Patch + , Renderer , Renderer.Patch , Renderer.Split , Renderer.Unified @@ -32,7 +33,6 @@ library , Term , Range , Parser - , Renderer , TreeSitter , Source build-depends: base >= 4.8 && < 5 From 4a0e01a230fbb46faf21874c9b8faf535aa0f893 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 26 Feb 2016 12:09:35 -0700 Subject: [PATCH 06/14] Stub in Free/Cofree types. --- src/Control/Comonad/Cofree.hs | 3 +++ src/Control/Monad/Free.hs | 3 +++ 2 files changed, 6 insertions(+) create mode 100644 src/Control/Comonad/Cofree.hs create mode 100644 src/Control/Monad/Free.hs diff --git a/src/Control/Comonad/Cofree.hs b/src/Control/Comonad/Cofree.hs new file mode 100644 index 000000000..3cf028ae3 --- /dev/null +++ b/src/Control/Comonad/Cofree.hs @@ -0,0 +1,3 @@ +module Control.Comonad.Cofree where + +data Cofree functor annotation = annotation :< functor diff --git a/src/Control/Monad/Free.hs b/src/Control/Monad/Free.hs new file mode 100644 index 000000000..d0312dac2 --- /dev/null +++ b/src/Control/Monad/Free.hs @@ -0,0 +1,3 @@ +module Control.Monad.Free where + +data Free functor pure = Free (functor (Free functor pure)) | Pure pure From b268c966688892b1accf7e190f56ec3542d44fc8 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 26 Feb 2016 12:17:44 -0700 Subject: [PATCH 07/14] Correct the definition of Cofree. --- src/Control/Comonad/Cofree.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Control/Comonad/Cofree.hs b/src/Control/Comonad/Cofree.hs index 3cf028ae3..6faa4f6e5 100644 --- a/src/Control/Comonad/Cofree.hs +++ b/src/Control/Comonad/Cofree.hs @@ -1,3 +1,3 @@ module Control.Comonad.Cofree where -data Cofree functor annotation = annotation :< functor +data Cofree functor annotation = annotation :< (functor (Cofree functor annotation)) From 7775a35112aa8dbf9e5f26184d2123a452596ee1 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 26 Feb 2016 12:17:55 -0700 Subject: [PATCH 08/14] Derive Functor/Foldable/Traversable instances. --- src/Control/Comonad/Cofree.hs | 1 + src/Control/Monad/Free.hs | 1 + 2 files changed, 2 insertions(+) diff --git a/src/Control/Comonad/Cofree.hs b/src/Control/Comonad/Cofree.hs index 6faa4f6e5..edeedae96 100644 --- a/src/Control/Comonad/Cofree.hs +++ b/src/Control/Comonad/Cofree.hs @@ -1,3 +1,4 @@ module Control.Comonad.Cofree where data Cofree functor annotation = annotation :< (functor (Cofree functor annotation)) + deriving (Functor, Foldable, Traversable) diff --git a/src/Control/Monad/Free.hs b/src/Control/Monad/Free.hs index d0312dac2..b3dd9c8de 100644 --- a/src/Control/Monad/Free.hs +++ b/src/Control/Monad/Free.hs @@ -1,3 +1,4 @@ module Control.Monad.Free where data Free functor pure = Free (functor (Free functor pure)) | Pure pure + deriving (Functor, Foldable, Traversable) From 5525da7afd657c285fc96144efd9b4e0eda9cec9 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 26 Feb 2016 12:18:19 -0700 Subject: [PATCH 09/14] Write Eq instances. --- src/Control/Comonad/Cofree.hs | 4 ++++ src/Control/Monad/Free.hs | 6 ++++++ 2 files changed, 10 insertions(+) diff --git a/src/Control/Comonad/Cofree.hs b/src/Control/Comonad/Cofree.hs index edeedae96..7c7f4356f 100644 --- a/src/Control/Comonad/Cofree.hs +++ b/src/Control/Comonad/Cofree.hs @@ -1,4 +1,8 @@ +{-# LANGUAGE UndecidableInstances #-} module Control.Comonad.Cofree where data Cofree functor annotation = annotation :< (functor (Cofree functor annotation)) deriving (Functor, Foldable, Traversable) + +instance (Eq annotation, Eq (functor (Cofree functor annotation))) => Eq (Cofree functor annotation) where + a :< f == b :< g = a == b && f == g diff --git a/src/Control/Monad/Free.hs b/src/Control/Monad/Free.hs index b3dd9c8de..20555c787 100644 --- a/src/Control/Monad/Free.hs +++ b/src/Control/Monad/Free.hs @@ -1,4 +1,10 @@ +{-# LANGUAGE UndecidableInstances #-} module Control.Monad.Free where data Free functor pure = Free (functor (Free functor pure)) | Pure pure deriving (Functor, Foldable, Traversable) + +instance (Eq pure, Eq (functor (Free functor pure))) => Eq (Free functor pure) where + Pure a == Pure b = a == b + Free f == Free g = f == g + _ == _ = False From aa66c8928277cc3010496162c3fa62405dc9c9b6 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 26 Feb 2016 12:18:24 -0700 Subject: [PATCH 10/14] Implement unwrap. --- src/Control/Comonad/Cofree.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Control/Comonad/Cofree.hs b/src/Control/Comonad/Cofree.hs index 7c7f4356f..0afa8455b 100644 --- a/src/Control/Comonad/Cofree.hs +++ b/src/Control/Comonad/Cofree.hs @@ -6,3 +6,6 @@ data Cofree functor annotation = annotation :< (functor (Cofree functor annotati instance (Eq annotation, Eq (functor (Cofree functor annotation))) => Eq (Cofree functor annotation) where a :< f == b :< g = a == b && f == g + +unwrap :: Cofree functor annotation -> functor (Cofree functor annotation) +unwrap (_ :< f) = f From fa58cff167bd4a06a53dbff2dd8b4811e22e6c28 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 26 Feb 2016 12:20:27 -0700 Subject: [PATCH 11/14] Implement iter. --- src/Control/Monad/Free.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Control/Monad/Free.hs b/src/Control/Monad/Free.hs index 20555c787..b1d9d0ddf 100644 --- a/src/Control/Monad/Free.hs +++ b/src/Control/Monad/Free.hs @@ -8,3 +8,7 @@ instance (Eq pure, Eq (functor (Free functor pure))) => Eq (Free functor pure) w Pure a == Pure b = a == b Free f == Free g = f == g _ == _ = False + +iter :: Functor functor => (functor pure -> pure) -> Free functor pure -> pure +iter _ (Pure a) = a +iter f (Free g) = f (iter f <$> g) From 4b15f127351f244d886254007a0c951f907a5161 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 26 Feb 2016 12:20:55 -0700 Subject: [PATCH 12/14] Replace `free` with Control.Monad.Free & Control.Comonad.Cofree. --- semantic-diff.cabal | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 3e6d67bee..ea899e210 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -35,6 +35,8 @@ library , Renderer , TreeSitter , Source + , Control.Monad.Free + , Control.Comonad.Cofree build-depends: base >= 4.8 && < 5 , bifunctors , blaze-html @@ -43,7 +45,6 @@ library , c-storable-deriving , containers , filepath - , free , mtl , rainbow , semigroups @@ -71,7 +72,6 @@ executable semantic-diff-exe , containers , directory , filepath - , free , optparse-applicative , rainbow , semantic-diff @@ -106,7 +106,6 @@ executable semantic-diff , containers , directory , filepath - , free , optparse-applicative , semantic-diff , text >= 1.2.1.3 @@ -142,7 +141,6 @@ test-suite semantic-diff-test , containers , deepseq , filepath - , free , Glob , hspec >= 2.1.10 , QuickCheck >= 2.8.1 From 55bca5ed1ede3e6b75e1df6f32b61d2f6a4193a5 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 26 Feb 2016 12:26:40 -0700 Subject: [PATCH 13/14] Implement unfold. --- src/Control/Comonad/Cofree.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Control/Comonad/Cofree.hs b/src/Control/Comonad/Cofree.hs index 0afa8455b..59b8ffc56 100644 --- a/src/Control/Comonad/Cofree.hs +++ b/src/Control/Comonad/Cofree.hs @@ -9,3 +9,6 @@ instance (Eq annotation, Eq (functor (Cofree functor annotation))) => Eq (Cofree unwrap :: Cofree functor annotation -> functor (Cofree functor annotation) unwrap (_ :< f) = f + +unfold :: Functor functor => (seed -> (annotation, functor seed)) -> seed -> Cofree functor annotation +unfold grow seed = case grow seed of (annotation, functor) -> annotation :< (unfold grow <$> functor) From d5a59ff9b0f017bcaecd9a09de7cfe91ef18f9a5 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 26 Feb 2016 12:32:00 -0700 Subject: [PATCH 14/14] Add Show instances. --- src/Control/Comonad/Cofree.hs | 3 +++ src/Control/Monad/Free.hs | 4 ++++ 2 files changed, 7 insertions(+) diff --git a/src/Control/Comonad/Cofree.hs b/src/Control/Comonad/Cofree.hs index 59b8ffc56..bf80577e6 100644 --- a/src/Control/Comonad/Cofree.hs +++ b/src/Control/Comonad/Cofree.hs @@ -7,6 +7,9 @@ data Cofree functor annotation = annotation :< (functor (Cofree functor annotati instance (Eq annotation, Eq (functor (Cofree functor annotation))) => Eq (Cofree functor annotation) where a :< f == b :< g = a == b && f == g +instance (Show annotation, Show (functor (Cofree functor annotation))) => Show (Cofree functor annotation) where + showsPrec n (a :< f) = showsPrec n a . (" :< " ++) . showsPrec n f + unwrap :: Cofree functor annotation -> functor (Cofree functor annotation) unwrap (_ :< f) = f diff --git a/src/Control/Monad/Free.hs b/src/Control/Monad/Free.hs index b1d9d0ddf..4c7a1271c 100644 --- a/src/Control/Monad/Free.hs +++ b/src/Control/Monad/Free.hs @@ -9,6 +9,10 @@ instance (Eq pure, Eq (functor (Free functor pure))) => Eq (Free functor pure) w Free f == Free g = f == g _ == _ = False +instance (Show pure, Show (functor (Free functor pure))) => Show (Free functor pure) where + showsPrec n (Pure a) = ("Pure " ++) . showsPrec n a + showsPrec n (Free f) = ("Free " ++) . showsPrec n f + iter :: Functor functor => (functor pure -> pure) -> Free functor pure -> pure iter _ (Pure a) = a iter f (Free g) = f (iter f <$> g)