Stub diffSummary'

semantic-diff.cabal

@@ -63,6 +63,7 @@ library
                      , vector
                      , recursion-schemes
                      , free
+                     , comonad
   default-language:    Haskell2010
   default-extensions:  DeriveFunctor, DeriveFoldable, DeriveTraversable, DeriveGeneric, OverloadedStrings
   ghc-options:        -Wall -fno-warn-name-shadowing -O2 -threaded -fprof-auto "-with-rtsopts=-N -p -s -h -i0.1" -j

src/Diff.hs

@@ -1,7 +1,9 @@
+{-# LANGUAGE TypeFamilies, TypeSynonymInstances, FlexibleInstances #-}
 module Diff where
 
 import Control.Comonad.Trans.Cofree
-import Control.Monad.Free
+import Control.Monad.Trans.Free
+import Data.Functor.Foldable as Foldable
 import Data.Functor.Both
 import Patch
 import Syntax
@@ -20,9 +22,13 @@ annotate :: annotation -> Syntax a f -> CofreeF (Syntax a) annotation f
 annotate = (:<)
 
 -- | An annotated series of patches of terms.
+type DiffF a annotation = FreeF (CofreeF (Syntax a) (Both annotation)) (Patch (Term a annotation))
 type Diff a annotation = Free (CofreeF (Syntax a) (Both annotation)) (Patch (Term a annotation))
+type instance Base (Diff a annotation) = DiffF a annotation
+type instance Base (Free f a) = FreeF f a
+
+instance (Functor f) => Foldable.Foldable (Free f a) where project = runFree
 
--- | Sum the result of a transform applied to all the patches in the diff.
 diffSum :: (Patch (Term a annotation) -> Integer) -> Diff a annotation -> Integer
 diffSum patchCost diff = sum $ fmap patchCost diff
 

src/DiffSummary.hs

@@ -8,12 +8,16 @@ import Term
 import Syntax
 import qualified Data.Text as T
 import qualified Category
+import Data.Functor.Both
 import Data.Monoid
 import Data.Maybe (listToMaybe)
 import Data.Set (toList)
 import Control.Arrow
 import Control.Monad
+import Control.Comonad
 import Control.Comonad.Trans.Cofree
+import Control.Monad.Trans.Free
+import qualified Control.Comonad.Cofree as Cofree
 import Data.Functor.Foldable as Foldable
 
 
@@ -30,11 +34,19 @@ patchSummary termSummary patch = memptyOrDiff (before patch) <> memptyOrDiff (af
   where
     memptyOrDiff = maybe emptyDiffSummary termSummary
 
-diffSummary :: Diff a Info -> DiffSummary
-diffSummary = histo diffSummary' where
-  diffSummary' :: DiffF a (Cofree (DiffF a Info) DiffSummary) f -> DiffSummary
-  diffSummary' (coDiffSummary :< Leaf _) = diffSummary
-    where (diffSummary :< _) = runCofree coDiffSummary
+type DiffSummaryF leaf annotation = FreeF (CofreeF (Syntax leaf) (Both annotation))
+diffSummary :: Diff leaf Info -> DiffSummary
+-- histo :: Foldable t => (Base t (Cofree (Base t) a) -> a) -> t -> a
+diffSummary = histo diffSummary' . fmap (patchSummary undefined) where
+  --diffSummary' :: DiffF leaf (Cofree.Cofree (DiffF leaf Info) DiffSummary) f -> DiffSummary
+  -- Skip any child that doesn't have any changes (that will always include leaves)
+  -- Skip any child that doesn't have any changes (that will always include leaves)
+  diffSummary' :: DiffSummaryF leaf annotation DiffSummary (Cofree.Cofree (DiffSummaryF leaf annotation DiffSummary) DiffSummary) -> DiffSummary
+  diffSummary' (Free (_ :< Leaf _)) = undefined
+  diffSummary' (Free (_ :< Indexed children)) = DiffSummary { diffChanges = children >>= diffChanges . extract }
+  diffSummary' (Free (_ :< Fixed children)) = undefined
+  diffSummary' (Free (_ :< Keyed children)) = undefined
+  diffSummary' (Pure diffSummary) = diffSummary :: DiffSummary
   -- (patchSummary termSummary)
 
 -- Syntax Text DiffSummary -> DiffSummary Text