Remove my unnecessary pattern functor for Cofree

@ChrisPenner [pointed out that `free` already has one](#5376 (review)).
unisonweb · Dec 11, 2024 · bb5a56c · bb5a56c
1 parent 0fa62a4
commit bb5a56c
Show file tree

Hide file tree

Showing 5 changed files with 11 additions and 9 deletions.
diff --git a/lib/unison-util-recursion/src/Unison/Util/Recursion.hs b/lib/unison-util-recursion/src/Unison/Util/Recursion.hs
@@ -8,12 +8,13 @@ module Unison.Util.Recursion
     cataM,
     para,
     Fix (..),
-    Cofree' (..),
   )
 where
 
 import Control.Arrow ((&&&))
 import Control.Comonad.Cofree (Cofree ((:<)))
+import Control.Comonad.Trans.Cofree (CofreeF)
+import Control.Comonad.Trans.Cofree qualified as CofreeF
 import Control.Monad ((<=<))
 
 type Algebra f a = f a -> a
@@ -46,12 +47,9 @@ instance (Functor f) => Recursive (Fix f) f where
   embed = Fix
   project (Fix f) = f
 
-data Cofree' f a x = a :<< f x
-  deriving (Foldable, Functor, Traversable)
-
 -- |
 --
 --  __NB__: `Cofree` from “free” is lazy, so this instance is technically partial.
-instance (Functor f) => Recursive (Cofree f a) (Cofree' f a) where
-  embed (a :<< fco) = a :< fco
-  project (a :< fco) = a :<< fco
+instance (Functor f) => Recursive (Cofree f a) (CofreeF f a) where
+  embed (a CofreeF.:< fco) = a :< fco
+  project (a :< fco) = a CofreeF.:< fco
diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs
@@ -13,6 +13,7 @@ module Unison.Syntax.TermParser
   )
 where
 
+import Control.Comonad.Trans.Cofree (CofreeF ((:<)))
 import Control.Monad.Reader (asks, local)
 import Data.Bitraversable (bitraverse)
 import Data.Char qualified as Char
@@ -607,7 +608,7 @@ doc2Block = do
   let docAnn = Ann startDoc endDoc
   (docAnn,) . docUntitledSection (gann docAnn) <$> traverse foldTop docContents
   where
-    foldTop = cataM \(a :<< top) -> docTop a =<< bitraverse (cataM \(a :<< leaf) -> docLeaf a leaf) pure top
+    foldTop = cataM \(a :< top) -> docTop a =<< bitraverse (cataM \(a :< leaf) -> docLeaf a leaf) pure top
 
     gann :: (Annotated a) => a -> Ann
     gann = Ann.GeneratedFrom . ann

diff --git a/unison-syntax/package.yaml b/unison-syntax/package.yaml
@@ -39,6 +39,7 @@ tests:
       - base
       - code-page
       - easytest
+      - free
       - megaparsec
       - unison-core1
       - unison-prelude

diff --git a/unison-syntax/test/Unison/Test/Doc.hs b/unison-syntax/test/Unison/Test/Doc.hs
@@ -1,5 +1,6 @@
 module Unison.Test.Doc (test) where
 
+import Control.Comonad.Trans.Cofree (CofreeF ((:<)))
 import Data.Bifunctor (first)
 import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.Text (Text)
@@ -137,7 +138,7 @@ t s expected =
       (crash . P.errorBundlePretty)
       ( \actual ->
           let expected' = Doc.UntitledSection $ embed <$> expected
-              actual' = cata (\(_ :<< top) -> embed $ first (cata \(_ :<< leaf) -> embed leaf) top) <$> actual
+              actual' = cata (\(_ :< top) -> embed $ first (cata \(_ :< leaf) -> embed leaf) top) <$> actual
            in if actual' == expected'
                 then ok
                 else do

diff --git a/unison-syntax/unison-syntax.cabal b/unison-syntax/unison-syntax.cabal
@@ -130,6 +130,7 @@ test-suite syntax-tests
       base
     , code-page
     , easytest
+    , free
     , megaparsec
     , text
     , unison-core1