Move the algebras into their own module.

semantic-diff.cabal

@@ -21,6 +21,7 @@ library
                      , Assigning.Assignment.Table
                      , Category
                      -- General datatype definitions & generic algorithms
+                     , Data.Algebra
                      , Data.Align.Generic
                      , Data.AST
                      , Data.Blob

src/Analysis/Decorator.hs

@@ -1,14 +1,6 @@
 {-# LANGUAGE DataKinds, GADTs, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Analysis.Decorator
-( FAlgebra
-, RAlgebra
-, OpenFAlgebra
-, OpenRAlgebra
-, fToR
-, fToOpenR
-, rToOpenR
-, openFToOpenR
-, decoratorWithAlgebra
+( decoratorWithAlgebra
 , syntaxIdentifierAlgebra
 , cyclomaticComplexityAlgebra
 , ConstructorName(..)
@@ -18,6 +10,7 @@ module Analysis.Decorator
 ) where
 
 import Data.Aeson
+import Data.Algebra
 import Data.Bifunctor (second)
 import Data.ByteString.Char8 (ByteString, pack, unpack)
 import Data.Foldable (asum)
@@ -34,34 +27,6 @@ import Data.Union
 import GHC.Generics
 import qualified Syntax as S
 
--- | An F-algebra on some 'Recursive' type @t@.
-type FAlgebra t a = Base t a -> a
-
--- | An R-algebra on some 'Recursive' type @t@.
-type RAlgebra t a = Base t (t, a) -> a
-
--- | An open-recursive F-algebra on some 'Recursive' type @t@.
-type OpenFAlgebra t a = forall b . (b -> a) -> Base t b -> a
-
--- | An open-recursive R-algebra on some 'Recursive' type @t@.
-type OpenRAlgebra t a = forall b . (b -> (t, a)) -> Base t b -> a
-
--- | Promote an 'FAlgebra' into an 'RAlgebra' (by dropping the original parameter).
-fToR :: Functor (Base t) => FAlgebra t a -> RAlgebra t a
-fToR f = f . fmap snd
-
--- | Promote an 'FAlgebra' into an 'OpenRAlgebra' (by 'fmap'ing the action over the structure and dropping the original parameter).
-fToOpenR :: Functor (Base t) => FAlgebra t a -> OpenRAlgebra t a
-fToOpenR alg f = alg . fmap (snd . f)
-
--- | Promote an 'RAlgebra' into an 'OpenRAlgebra' (by 'fmap'ing the action over the structure).
-rToOpenR :: Functor (Base t) => RAlgebra t a -> OpenRAlgebra t a
-rToOpenR alg f = alg . fmap f
-
--- | Promote an 'OpenFAlgebra' into an 'OpenRAlgebra' (by dropping the original parameter).
-openFToOpenR :: OpenFAlgebra t a -> OpenRAlgebra t a
-openFToOpenR alg = alg . fmap snd
-
 -- | Lift an algebra into a decorator for terms annotated with records.
 decoratorWithAlgebra :: Functor syntax
                      => RAlgebra (Term syntax (Record fs)) a -- ^ An R-algebra on terms.

src/Data/Algebra.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE RankNTypes #-}
+module Data.Algebra
+( FAlgebra
+, RAlgebra
+, OpenFAlgebra
+, OpenRAlgebra
+, fToR
+, fToOpenR
+, rToOpenR
+, openFToOpenR
+) where
+
+import Data.Functor.Foldable (Base)
+
+-- | An F-algebra on some 'Recursive' type @t@.
+type FAlgebra t a = Base t a -> a
+
+-- | An R-algebra on some 'Recursive' type @t@.
+type RAlgebra t a = Base t (t, a) -> a
+
+-- | An open-recursive F-algebra on some 'Recursive' type @t@.
+type OpenFAlgebra t a = forall b . (b -> a) -> Base t b -> a
+
+-- | An open-recursive R-algebra on some 'Recursive' type @t@.
+type OpenRAlgebra t a = forall b . (b -> (t, a)) -> Base t b -> a
+
+-- | Promote an 'FAlgebra' into an 'RAlgebra' (by dropping the original parameter).
+fToR :: Functor (Base t) => FAlgebra t a -> RAlgebra t a
+fToR f = f . fmap snd
+
+-- | Promote an 'FAlgebra' into an 'OpenRAlgebra' (by 'fmap'ing the action over the structure and dropping the original parameter).
+fToOpenR :: Functor (Base t) => FAlgebra t a -> OpenRAlgebra t a
+fToOpenR alg f = alg . fmap (snd . f)
+
+-- | Promote an 'RAlgebra' into an 'OpenRAlgebra' (by 'fmap'ing the action over the structure).
+rToOpenR :: Functor (Base t) => RAlgebra t a -> OpenRAlgebra t a
+rToOpenR alg f = alg . fmap f
+
+-- | Promote an 'OpenFAlgebra' into an 'OpenRAlgebra' (by dropping the original parameter).
+openFToOpenR :: OpenFAlgebra t a -> OpenRAlgebra t a
+openFToOpenR alg = alg . fmap snd

src/Rendering/TOC.hs

@@ -20,8 +20,8 @@ module Rendering.TOC
 , toCategoryName
 ) where
 
-import Analysis.Decorator (RAlgebra)
 import Data.Aeson
+import Data.Algebra (RAlgebra)
 import Data.Align (bicrosswalk)
 import Data.Bifoldable (bifoldMap)
 import Data.Bifunctor (bimap)

src/Semantic/Task.hs

@@ -25,7 +25,7 @@ module Semantic.Task
 , runTaskWithOptions
 ) where
 
-import Analysis.Decorator (RAlgebra, decoratorWithAlgebra)
+import Analysis.Decorator (decoratorWithAlgebra)
 import qualified Assigning.Assignment as Assignment
 import Control.Exception
 import Control.Monad.Error.Class
@@ -33,6 +33,7 @@ import Control.Monad.IO.Class
 import Control.Parallel.Strategies
 import qualified Control.Concurrent.Async as Async
 import Control.Monad.Free.Freer
+import Data.Algebra (RAlgebra)
 import Data.Blob
 import Data.Bool
 import qualified Data.ByteString as B