Migrate everything over to Data.Union.

src/Data/Syntax/Algebra.hs

@@ -9,11 +9,11 @@ module Data.Syntax.Algebra
 ) where
 
 import Data.Functor.Foldable
-import Data.Functor.Union
 import Data.Record
 import qualified Data.Syntax as Syntax
 import qualified Data.Syntax.Declaration as Declaration
 import qualified Data.Syntax.Statement as Statement
+import Data.Union
 import Prologue
 import Term
 
@@ -41,7 +41,7 @@ newtype Identifier = Identifier ByteString
 -- | Produce the identifier for a given term, if any.
 --
 --   Identifier syntax is labelled, as well as declaration syntax identified by these, but other uses of these identifiers are not, e.g. the declaration of a class or method or binding of a variable will be labelled, but a function call will not.
-identifierAlgebra :: (InUnion fs Syntax.Identifier, InUnion fs Declaration.Method, InUnion fs Declaration.Class, Traversable (Union fs)) => FAlgebra (Base (Term (Union fs) a)) (Maybe Identifier)
+identifierAlgebra :: (Syntax.Identifier :< fs, Declaration.Method :< fs, Declaration.Class :< fs, Traversable (Union fs)) => FAlgebra (Base (Term (Union fs) a)) (Maybe Identifier)
 identifierAlgebra (_ :< union) = case union of
   _ | Just (Syntax.Identifier s) <- prj union -> Just (Identifier s)
   _ | Just Declaration.Class{..} <- prj union -> classIdentifier
@@ -57,7 +57,7 @@ newtype CyclomaticComplexity = CyclomaticComplexity Int
 --   TODO: Explicit returns at the end of methods should only count once.
 --   TODO: Anonymous functions should not increase parent scope’s complexity.
 --   TODO: Inner functions should not increase parent scope’s complexity.
-cyclomaticComplexityAlgebra :: (InUnion fs Declaration.Method, InUnion fs Statement.Return, InUnion fs Statement.Yield, Traversable (Union fs)) => FAlgebra (Base (Term (Union fs) a)) CyclomaticComplexity
+cyclomaticComplexityAlgebra :: (Declaration.Method :< fs, Statement.Return :< fs, Statement.Yield :< fs, Traversable (Union fs)) => FAlgebra (Base (Term (Union fs) a)) CyclomaticComplexity
 cyclomaticComplexityAlgebra (_ :< union) = case union of
   _ | Just Declaration.Method{} <- prj union -> succ (sum union)
   _ | Just Statement.Return{} <- prj union -> succ (sum union)

src/Data/Syntax/Literal.hs

@@ -4,7 +4,7 @@ module Data.Syntax.Literal where
 import Data.Align.Generic
 import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Classes.Show.Generic
-import Data.Functor.Union
+import Data.Union
 import GHC.Generics
 import Prologue hiding (Set)
 
@@ -132,4 +132,3 @@ instance Show1 Set where liftShowsPrec = genericLiftShowsPrec
 -- TODO: Object literals as distinct from hash literals? Or coalesce object/hash literals into “key-value literals”?
 -- TODO: Function literals (lambdas, procs, anonymous functions, what have you).
 -- TODO: Regexp literals.
-

src/Language/Python/Syntax.hs

@@ -10,7 +10,6 @@ module Language.Python.Syntax
 import Data.Align.Generic
 import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Classes.Show.Generic
-import Data.Functor.Union
 import qualified Data.Syntax as Syntax
 import Data.Syntax.Assignment hiding (Error)
 import qualified Data.Syntax.Assignment as Assignment
@@ -19,6 +18,7 @@ import qualified Data.Syntax.Declaration as Declaration
 import qualified Data.Syntax.Expression as Expression
 import qualified Data.Syntax.Literal as Literal
 import qualified Data.Syntax.Statement as Statement
+import Data.Union
 import GHC.Generics
 import GHC.Stack
 import Language.Python.Grammar as Grammar
@@ -319,7 +319,7 @@ comprehension =  makeTerm <$> symbol GeneratorExpression <*> children (comprehen
 conditionalExpression :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
 conditionalExpression = makeTerm <$> symbol ConditionalExpression <*> children (expression >>= \ thenBranch -> expression >>= \ conditional -> Statement.If conditional thenBranch <$> (expression <|> emptyTerm))
 
-makeTerm :: HasCallStack => InUnion Syntax' f => a -> f (Term Syntax a) -> Term Syntax a
+makeTerm :: HasCallStack => f :< Syntax' => a -> f (Term Syntax a) -> Term Syntax a
 makeTerm a f = cofree (a :< inj f)
 
 emptyTerm :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)

src/Language/Ruby/Syntax.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DataKinds, TypeOperators #-}
 module Language.Ruby.Syntax
 ( assignment
 , Syntax
@@ -7,7 +7,6 @@ module Language.Ruby.Syntax
 , Error
 ) where
 
-import Data.Functor.Union
 import qualified Data.Syntax as Syntax
 import Data.Syntax.Assignment hiding (Error)
 import qualified Data.Syntax.Assignment as Assignment
@@ -16,6 +15,7 @@ import qualified Data.Syntax.Declaration as Declaration
 import qualified Data.Syntax.Expression as Expression
 import qualified Data.Syntax.Literal as Literal
 import qualified Data.Syntax.Statement as Statement
+import Data.Union
 import GHC.Stack
 import Language.Ruby.Grammar as Grammar
 import Prologue hiding (for, get, Location, state, unless)
@@ -149,10 +149,10 @@ literal  =  makeTerm <$> symbol Grammar.True <*> (Literal.true <$ source)
         <|> makeTerm <$> symbol Symbol <*> (Literal.Symbol <$> source)
         <|> makeTerm <$> symbol Range <*> children (Literal.Range <$> statement <*> statement) -- FIXME: represent the difference between .. and ...
 
-invert :: (InUnion fs Expression.Boolean, HasCallStack) => Assignment (Node grammar) (Term (Union fs) Location) -> Assignment (Node grammar) (Term (Union fs) Location)
+invert :: (Expression.Boolean :< fs, HasCallStack) => Assignment (Node grammar) (Term (Union fs) Location) -> Assignment (Node grammar) (Term (Union fs) Location)
 invert term = makeTerm <$> location <*> fmap Expression.Not term
 
-makeTerm :: (InUnion fs f, HasCallStack) => a -> f (Term (Union fs) a) -> (Term (Union fs) a)
+makeTerm :: (f :< fs, HasCallStack) => a -> f (Term (Union fs) a) -> (Term (Union fs) a)
 makeTerm a f = cofree $ a :< inj f
 
 emptyTerm :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)

src/Parser.hs

@@ -1,12 +1,11 @@
-{-# LANGUAGE GADTs, ScopedTypeVariables #-}
+{-# LANGUAGE GADTs, ScopedTypeVariables, TypeOperators #-}
 module Parser where
 
-import Data.Functor.Union
 import Data.Record
 import qualified Data.Syntax as Syntax
 import Data.Syntax.Assignment
-import Data.Functor.Union (inj)
 import qualified Data.Text as T
+import Data.Union
 import Info hiding (Empty, Go)
 import Language
 import Language.Markdown
@@ -32,7 +31,7 @@ data Parser term where
   -- | A parser producing 'AST' using a 'TS.Language'.
   ASTParser :: (Bounded grammar, Enum grammar) => Ptr TS.Language -> Parser (AST grammar)
   -- | A parser producing an à la carte term given an 'AST'-producing parser and an 'Assignment' onto 'Term's in some syntax type. Assignment errors will result in a top-level 'Syntax.Error' node.
-  AssignmentParser :: (Bounded grammar, Enum grammar, Eq grammar, Show grammar, Symbol grammar, InUnion fs (Syntax.Error (Error grammar)), Traversable (Union fs))
+  AssignmentParser :: (Bounded grammar, Enum grammar, Eq grammar, Show grammar, Symbol grammar, Syntax.Error (Error grammar) :< fs, Traversable (Union fs))
                    => Parser (AST grammar)                                 -- ^ A parser producing 'AST'.
                    -> Assignment (Node grammar) (Term (Union fs) Location) -- ^ An assignment from 'AST' onto 'Term's.
                    -> Parser (Term (Union fs) Location)                    -- ^ A parser of 'Term's.
@@ -80,10 +79,10 @@ runParser parser = case parser of
   where showSGRCode = showString . setSGRCode
         withSGRCode code s = showSGRCode code . s . showSGRCode []
 
-errorTerm :: InUnion fs (Syntax.Error (Error grammar)) => Source -> Maybe (Error grammar) -> Term (Union fs) Location
+errorTerm :: Syntax.Error (Error grammar) :< fs => Source -> Maybe (Error grammar) -> Term (Union fs) Location
 errorTerm source err = cofree ((totalRange source :. totalSpan source :. Nil) :< inj (Syntax.Error (fromMaybe (Error (SourcePos 0 0) (UnexpectedEndOfInput [])) err)))
 
-termErrors :: (InUnion fs (Syntax.Error (Error grammar)), Functor (Union fs), Foldable (Union fs)) => Term (Union fs) a -> [Error grammar]
+termErrors :: (Syntax.Error (Error grammar) :< fs, Functor (Union fs), Foldable (Union fs)) => Term (Union fs) a -> [Error grammar]
 termErrors = cata $ \ (_ :< s) -> case s of
   _ | Just (Syntax.Error err) <- prj s -> [err]
   _ -> fold s

src/Renderer/JSON.hs

@@ -10,9 +10,9 @@ import Data.Aeson (ToJSON, toJSON, encode, object, (.=))
 import Data.Aeson as A hiding (json)
 import Data.Bifunctor.Join
 import Data.Functor.Both (Both)
-import Data.Functor.Union
 import qualified Data.Map as Map
 import Data.Record
+import Data.Union
 import Info
 import Language
 import Patch
@@ -104,8 +104,9 @@ instance ToJSON recur => ToJSONFields (Syntax leaf recur) where
   toJSONFields syntax = [ "children" .= toList syntax ]
 
 instance (Foldable f, ToJSON a, ToJSONFields (Union fs a)) => ToJSONFields (Union (f ': fs) a) where
-  toJSONFields (Here f) = [ "children" .= toList f ]
-  toJSONFields (There fs) = toJSONFields fs
+  toJSONFields u = case decompose u of
+    Left u' -> toJSONFields u'
+    Right r -> [ "children" .= toList r ]
 
 instance ToJSONFields (Union '[] a) where
   toJSONFields _ = []

src/Renderer/TOC.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, RankNTypes #-}
+{-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, RankNTypes, TypeOperators #-}
 module Renderer.TOC
 ( renderToC
 , diffTOC
@@ -20,12 +20,12 @@ import Data.Align (crosswalk)
 import Data.Functor.Both hiding (fst, snd)
 import qualified Data.Functor.Both as Both
 import Data.Functor.Listable
-import Data.Functor.Union
 import Data.Proxy
+import Data.Record
 import Data.Text (toLower)
 import Data.Text.Listable
 import Data.These
-import Data.Record
+import Data.Union
 import Diff
 import Info
 import Patch
@@ -99,7 +99,7 @@ syntaxDeclarationAlgebra source r = case tailF r of
   where getSource = toText . flip Source.slice source . byteRange . extract
 
 -- | Compute 'Declaration's for methods and functions.
-declarationAlgebra :: (InUnion fs Declaration.Function, InUnion fs Declaration.Method, InUnion fs (Syntax.Error error), Show error, Functor (Union fs), HasField fields Range)
+declarationAlgebra :: (Declaration.Function :< fs, Declaration.Method :< fs, Syntax.Error error :< fs, Show error, Functor (Union fs), HasField fields Range)
                    => Proxy error
                    -> Source
                    -> RAlgebra (TermF (Union fs) (Record fields)) (Term (Union fs) (Record fields)) (Maybe Declaration)

src/Semantic.hs

@@ -11,10 +11,10 @@ import Algorithm hiding (diff)
 import Data.Align.Generic (GAlign)
 import Data.Functor.Both as Both
 import Data.Functor.Classes (Eq1, Show1)
-import Data.Functor.Union
 import Data.Proxy
 import Data.Record
 import qualified Data.Syntax.Declaration as Declaration
+import Data.Union
 import Diff
 import Info
 import Interpreter