diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 972c37ccf..65baf4ebd 100644 --- a/semantic-diff.cabal +++ b/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 diff --git a/src/Diff.hs b/src/Diff.hs index dca069b7d..e363f02bf 100644 --- a/src/Diff.hs +++ b/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 diff --git a/src/DiffSummary.hs b/src/DiffSummary.hs index 37b7b4dc7..8f224f8a2 100644 --- a/src/DiffSummary.hs +++ b/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