Define Algorithm as the Freer monad of AlgorithmF.

semantic-diff.cabal

@@ -77,6 +77,7 @@ library
                      , dlist
                      , filepath
                      , free
+                     , freer-cofreer
                      , gitlib
                      , gitlib-libgit2
                      , gitrev

src/Algorithm.hs

@@ -1,9 +1,9 @@
 {-# LANGUAGE GADTs, RankNTypes #-}
 module Algorithm where
 
-import Control.Applicative.Free
+import Control.Monad.Free.Freer
 import Data.These
-import Prologue hiding (Pure)
+import Prologue hiding (liftF)
 
 -- | A single step in a diffing algorithm, parameterized by the types of terms, diffs, and the result of the applicable algorithm.
 data AlgorithmF term diff result where
@@ -21,20 +21,14 @@ data AlgorithmF term diff result where
   Replace :: term -> term -> AlgorithmF term diff diff
 
 -- | The free applicative for 'AlgorithmF'. This enables us to construct diff values using <$> and <*> notation.
-type Algorithm term diff = Ap (AlgorithmF term diff)
-
--- | Tear down an Ap by iteration, given a continuation.
-iterAp :: (forall x. g x -> (x -> a) -> a) -> Ap g a -> a
-iterAp algebra = go
-  where go (Pure a) = a
-        go (Ap underlying apply) = algebra underlying (go . (apply <*>) . pure)
+type Algorithm term diff = Freer (AlgorithmF term diff)
 
 
 -- DSL
 
 -- | Diff two terms without specifying the algorithm to be used.
 diff :: term -> term -> Algorithm term diff diff
-diff = (liftAp .) . Diff
+diff = (liftF .) . Diff
 
 -- | Diff a These of terms without specifying the algorithm to be used.
 diffThese :: These term term -> Algorithm term diff diff
@@ -42,20 +36,20 @@ diffThese = these byDeleting byInserting diff
 
 -- | Diff two terms linearly.
 linearly :: term -> term -> Algorithm term diff diff
-linearly a b = liftAp (Linear a b)
+linearly a b = liftF (Linear a b)
 
 -- | Diff two terms using RWS.
 byRWS :: [term] -> [term] -> Algorithm term diff [diff]
-byRWS a b = liftAp (RWS a b)
+byRWS a b = liftF (RWS a b)
 
 -- | Delete a term.
 byDeleting :: term -> Algorithm term diff diff
-byDeleting = liftAp . Delete
+byDeleting = liftF . Delete
 
 -- | Insert a term.
 byInserting :: term -> Algorithm term diff diff
-byInserting = liftAp . Insert
+byInserting = liftF . Insert
 
 -- | Replace one term with another.
 byReplacing :: term -> term -> Algorithm term diff diff
-byReplacing = (liftAp .) . Replace
+byReplacing = (liftF .) . Replace

src/Interpreter.hs

@@ -2,17 +2,17 @@
 module Interpreter (diffTerms, run, runSteps, runStep) where
 
 import Algorithm
-import Control.Applicative.Free
+import Control.Monad.Free.Freer
 import Data.Align.Generic
 import Data.Functor.Both
 import Data.RandomWalkSimilarity as RWS
 import Data.Record
 import Data.These
 import Diff
-import Info
+import Info hiding (Return)
 import Patch (inserting, deleting, replacing, patchSum)
-import Prologue hiding (lookup, Pure)
-import Syntax as S
+import Prologue hiding (lookup)
+import Syntax as S hiding (Return)
 import Term
 
 -- | Diff two terms recursively, given functions characterizing the diffing.
@@ -26,16 +26,14 @@ diffTerms = (run .) . diff
 run :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector))
     => Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result
     -> result
-run algorithm = case runStep algorithm of
-  Left a -> a
-  Right next -> run next
+run = either identity run . runStep
 
 -- | Run an Algorithm to completion, returning the list of steps taken.
 runSteps :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector))
     => Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result
     -> [Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result]
 runSteps algorithm = case runStep algorithm of
-  Left a -> [Pure a]
+  Left a -> [Return a]
   Right next -> next : runSteps next
 
 -- | Run a single step of an Algorithm, returning Either its result if it has finished, or the next step otherwise.
@@ -43,8 +41,8 @@ runStep :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVec
         => Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result
         -> Either result (Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result)
 runStep = \case
-  Pure a -> Left a
-  Ap algorithm cont -> Right $ cont <*> decompose algorithm
+  Return a -> Left a
+  Then algorithm cont -> Right $ decompose algorithm >>= cont
 
 
 -- | Decompose a step of an algorithm into the next steps to perform.