diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal
index 3889ec047e..0fa058889f 100644
--- a/cardano-cli/cardano-cli.cabal
+++ b/cardano-cli/cardano-cli.cabal
@@ -222,6 +222,10 @@ library
     Cardano.CLI.Type.MonadWarning
     Cardano.CLI.Type.Output
     Cardano.CLI.Type.TxFeature
+    Cardano.CLI.Vary
+    Cardano.CLI.Vary.Core
+    Cardano.CLI.Vary.Utils
+    Cardano.CLI.Vary.VEither
 
   other-modules: Paths_cardano_cli
   autogen-modules: Paths_cardano_cli
diff --git a/cardano-cli/src/Cardano/CLI/Vary.hs b/cardano-cli/src/Cardano/CLI/Vary.hs
new file mode 100644
index 0000000000..5dbca4ef81
--- /dev/null
+++ b/cardano-cli/src/Cardano/CLI/Vary.hs
@@ -0,0 +1,427 @@
+{-
+
+Copyright © 2024 Marten Wijnja (Qqwy)
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the “Software”), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+of the Software, and to permit persons to whom the Software is furnished to do
+so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+
+-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE EmptyCase #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE NoStarIsType #-}
+
+module Cardano.CLI.Vary
+  ( -- * General Usage
+    -- $setup
+    -- $motivating_example
+    -- $vary_and_exceptions
+    -- $vary_and_serialization
+
+    -- * Core type definition
+    Vary
+  , (:|)
+
+    -- * Construction and Destruction:
+  , from
+  , into
+  , intoOnly
+
+    -- * case analysis ("pattern matching"):
+
+    -- |
+    -- Vary does not support traditional pattern matching,
+    -- because GHC is not able to check them for exhaustiveness.
+    --
+    -- Instead, Vary supports the next best thing: building up a pattern match using the 'on' combinator.
+  , on
+  , exhaustiveCase
+  , defaultCase
+  , pop
+
+    -- * Transforming
+  , mapOn
+  , morph
+  , morphed
+  )
+where
+
+import Cardano.CLI.Vary.Core (Vary (..))
+import Cardano.CLI.Vary.Utils
+
+import Control.Monad (guard)
+import Data.Kind
+import GHC.TypeLits
+
+import Unsafe.Coerce (unsafeCoerce)
+
+-- $setup
+--
+-- == Setup
+--
+-- This module is intended to be used qualified:
+--
+-- >>> import Cardano.CLI.Vary (Vary, (:|))
+-- >>> import qualified Vary
+--
+-- You probably often want to use it together with the "Vary.VEither" module:
+--
+-- >>> import Cardano.CLI.Vary.VEither (VEither(VLeft, VRight))
+-- >>> import qualified Vary.VEither as VEither
+--
+-- And for many functions, it is useful (and sometimes outright necessary) to enable the following extensions:
+--
+-- >>> :set -XDataKinds
+--
+-- Finally, some example snippets in this module make use of 'Data.Function.&', the left-to-right function application operator.
+--
+-- >>> import Data.Function ((&))
+
+-- $motivating_example
+--
+--  == Motivating Example
+--
+-- A longer example on why you would want to use Vary [can be found in the package README on GitHub](https://github.com/qqwy/haskell-vary#readme)
+
+-- $vary_and_exceptions
+--
+-- == Vary and Exceptions #vary_and_exceptions#
+--
+-- 'Vary' implements 'Control.Exception.Exception',
+-- and is an /excellent/ type to use with 'Control.Exception.throw' and 'Control.Exception.catch'.
+--
+-- >>> import Control.Exception
+-- >>> no_xyzzy  = Vary.from (NoMethodError "xyzzy") :: Vary '[NoMethodError, ArithException]
+-- >>> divby0    = Vary.from DivideByZero            :: Vary '[NoMethodError, ArithException]
+--
+-- >>> throw no_xyzzy `catch` \(e :: Vary '[NoMethodError, ArithException]) -> putStrLn ("Caught: `" <> show e <> "`")
+-- Caught: `Vary.from @NoMethodError xyzzy`
+--
+-- === Catching individual errors of a thrown 'Vary'
+--
+-- 'Control.Exception.toException' is implemented to throw the particular /internal/ type.
+--
+-- This means that you can catch any of the particular individual possibilities of a thrown Vary if you like,
+-- and have the others bubble up:
+--
+-- >>> throw no_xyzzy `catch` \(e :: NoMethodError) -> putStrLn ("Caught: `" <> show e <> "`")
+-- Caught: `xyzzy`
+--
+-- >>> throw divby0 `catch` \(e :: NoMethodError) -> putStrLn ("Caught: `" <> show e <> "`")
+-- *** Exception: divide by zero
+--
+-- === Catching groups of (individually thrown) errors
+--
+-- Also, 'Control.Exception.fromException' is implemented to /match/ any of the contained possibilities:
+--
+-- >>> catcher inner = inner `catch` \(e :: Vary '[NoMethodError, ArithException]) -> putStrLn ("Caught: `" <> show e <> "`")
+--
+-- So not only is the following exception caught:
+--
+-- >>> vary = Vary.from (NoMethodError "plover") :: Vary '[NoMethodError, ArithException]
+-- >>> catcher (throw vary)
+-- Caught: `Vary.from @NoMethodError plover`
+--
+-- But it will also catch a thrown @ArithException@
+--
+-- >>> catcher (throw DivideByZero)
+-- Caught: `Vary.from @ArithException divide by zero`
+--
+-- or a thrown @NoMethodError@!
+--
+-- >>> catcher (throw (NoMethodError "plugh"))
+-- Caught: `Vary.from @NoMethodError plugh`
+--
+-- /(and other exceptions of course still bubble up)/
+--
+-- >>> catcher (throw AllocationLimitExceeded)
+-- *** Exception: allocation limit exceeded
+
+-- $vary_and_serialization
+--
+-- == (De)Serializing Vary values
+--
+-- `Vary` has optional dependencies to enable `aeson`'s `Data.Aeson`, `binary`'s `Data.Binary` and `cereal`'s `Data.Serealize` serialization.
+--
+-- Specifically for Aeson serialization, Vary datatypes are encoded
+-- as their ['UntaggedValue'](https://hackage.haskell.org/package/aeson-2.0.3.0/docs/Data-Aeson-Types.html#t:SumEncoding) encoding.
+-- This means that serialization to JSON only round-trips when the encodings are disjoint;
+-- on decoding, the first variant to succeed is used.
+--
+-- The Binary and Serialize instances always round-trip, as their encoding contains the variant's tag index.
+
+-- | Builds a Vary from the given value.
+--
+-- >>> let thingy :: Vary [Bool, Char]; thingy = Vary.from 'a'
+-- >>> thingy
+-- Vary.from @Char 'a'
+--
+-- In the case of number literals or (with OverloadedStrings or OverloadedLists enabled) string or list literals,
+-- it might be necessary to include a TypeApplication.
+-- In most other cases, GHC is able to infer which possibility to use (though you might still like type applications even here for improved readability).
+--
+-- >>> Vary.from @Int 42 :: Vary [Int, String]
+-- Vary.from @Int 42
+--
+-- In the case of the Vary contains duplicate types,
+-- the first matching type index is used.
+from
+  :: forall a l. a :| l => a -> Vary l
+{-# INLINE from #-}
+from = fromAt @(IndexOf a l)
+
+-- | Attempts to turn the Vary back into a particular type.
+--
+-- This might fail since the Vary might actually contain another possibility,
+-- which is why a `Maybe` is returned.
+--
+-- If you have a single possibility, you can use `intoOnly` instead.
+--
+-- == Polymorphic functions
+--
+-- If you pass the result to a polymorphic function, GHC might not be able to infer which result type you'd like to try to extract.
+-- Indicate the desired result type using a TypeApplication:
+--
+-- >>> let vary = Vary.from @Bool True :: Vary [Bool, String]
+-- >>> Vary.into @Bool vary
+-- Just True
+--
+-- == Type errors
+-- Sometimes you might see nasty long type errors, containing the string
+-- `Type_List_Too_Vague___Please_Specify_Prefix_Of_List_Including_The_Desired_Type's_Location`.
+--
+-- This happens when other parts of your code keep the type list fully abstract (only use the `:|` constraint).
+--
+-- You can fix it by either giving a type to an intermediate value,
+-- or by passing a second type application to this function:
+--
+-- >>> let vary = if True then Vary.from True else Vary.from 'a' -- Inferred type: `Bool :| l, Char :| l => Vary l`
+-- >>> Vary.into @Bool @(Char : Bool : _) vary
+-- Just True
+--
+-- As you can see from the above example, it is often not necessary to specify the /full/ type list.
+-- A prefix is commonly enough.
+into :: forall a l. a :| l => Vary l -> Maybe a
+{-# INLINE into #-}
+into = intoAt @(IndexOf a l)
+
+-- | Extract the value of a variant with one possibility.
+--
+-- A variant with only a single possibility
+-- can always be safely turned back into this one type.
+--
+-- If you have multiple possibilities, use `into`.
+intoOnly :: forall a. Vary '[a] -> a
+{-# INLINE intoOnly #-}
+intoOnly (Vary _ val) = unsafeCoerce val
+
+-- | Base case of an exhaustive pattern match.
+--
+-- Use it together with `on`,
+-- or whenever you have an empty `Vary '[]` that you need to get rid of.
+-- (Like in a recursive typeclass definition. See "Vary".'pop')
+--
+-- Since it is impossible to actually /construct/ a value of the type @Vary '[]@,
+-- we can "turn it into anything", just like `Data.Void.absurd`.
+exhaustiveCase :: forall anything. Vary '[] -> anything
+{-# INLINE exhaustiveCase #-}
+exhaustiveCase _vary =
+  error
+    "Somehow someone got their hands on a runtime value of type Vary '[]. This should be impossible, so someone did a bad unsafeCoerce somewhere!"
+
+-- | Base case of a non-exhaustive pattern match. Use it together with `on`.
+--
+-- If you've handled the variants you like and have some left,
+-- you can specify a default fallback value using `defaultCase`.
+--
+-- Indeed, this function is just another name for `const`.
+defaultCase :: forall a l. a -> Vary l -> a
+{-# INLINE defaultCase #-}
+defaultCase = const
+
+-- | Extend a smaller `Vary` into a bigger one, change the order of its elements, or get rid of duplicates.
+--
+-- === Extend a smaller `Vary`:
+-- >>> small = Vary.from True :: Vary '[Bool]
+-- >>> big = Vary.morph small :: Vary [Bool, Int, String]
+-- >>> big
+-- Vary.from @Bool True
+--
+-- === Reorder elements:
+-- >>> boolfirst = Vary.from @Int 42   :: Vary [Bool, Int]
+-- >>> intfirst = Vary.morph boolfirst :: Vary [Int, Bool]
+-- >>> intfirst
+-- Vary.from @Int 42
+--
+-- === Get rid of duplicate elements:
+-- >>> duplicates = Vary.from @Int 69       :: Vary [Int, Int, Int]
+-- >>> noduplicates = Vary.morph duplicates :: Vary '[Int]
+-- >>> noduplicates
+-- Vary.from @Int 69
+--
+-- === Type applications
+-- Morph intentionally takes the result type list as first type-application parameter.
+-- This allows you to write above examples in this more concise style instead:
+--
+-- >>> big = Vary.morph @[Bool, Int, String] small
+-- >>> intfirst = Vary.morph @[Int, Bool] boolfirst
+-- >>> noduplicates = Vary.morph @'[Int] duplicates
+--
+--
+-- == Efficiency
+-- This is a O(1) operation, as the tag number stored in the variant is
+-- changed to the new tag number.
+--
+-- In many cases GHC can even look through the old->new Variant structure entirely,
+-- and e.g. inline the variant construction all-together.
+morph :: forall ys xs. Subset xs ys => Vary xs -> Vary ys
+morph = morph' @xs @ys
+
+fromAt
+  :: forall (n :: Nat) (l :: [Type])
+   . KnownNat n
+  => Index n l
+  -> Vary l
+{-# INLINE fromAt #-}
+fromAt a = Vary (natValue @n) (unsafeCoerce a)
+
+intoAt
+  :: forall (n :: Nat) (l :: [Type])
+   . KnownNat n
+  => Vary l
+  -> Maybe (Index n l)
+{-# INLINE intoAt #-}
+intoAt (Vary t a) = do
+  guard (t == natValue @n)
+  return (unsafeCoerce a)
+
+-- | Handle a particular variant possibility.
+--
+-- This is the main way to do case analysis (or 'deconstruct') a variant.
+--
+-- Use it together with `exhaustiveCase` if you handle all possibilities,
+-- or `defaultCase` if you don't want to.
+--
+-- Even though in many cases GHC is able to infer the types,
+-- it is a good idea to combine it with `TypeApplications`:
+--
+-- Note that by doing so, GHC can infer the type of the function without problems:
+--
+-- >>> :{
+--   example vary =
+--     vary &
+--     ( Vary.on @Bool show
+--     $ Vary.on @Int (\x -> show (x + 1))
+--     $ Vary.defaultCase "other value"
+--     )
+-- :}
+--
+-- >>> :t example
+-- example :: Vary (Bool : Int : l) -> String
+on :: forall a b l. (a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
+{-# INLINE on #-}
+on thisFun restFun vary =
+  case into @a vary of
+    Just val -> thisFun val
+    Nothing ->
+      restFun (coerceHigher vary)
+ where
+  -- Invariant: does not contain @a
+  {-# INLINE coerceHigher #-}
+  coerceHigher :: Vary (a : l) -> Vary l
+  coerceHigher (Vary idx val) =
+    unsafeCoerce (Vary (idx - 1) val)
+
+-- | Execute a function expecting a larger (or differently-ordered) variant
+-- with a smaller (or differently-ordered) variant,
+-- by calling `morph` on it before running the function.
+morphed :: forall a b res. Subset a b => (Vary b -> res) -> Vary a -> res
+{-# INLINE morphed #-}
+morphed fun = fun . morph
+
+-- | Run a function on one of the variant's possibilities, keeping all other possibilities the same.
+--
+-- This is the generalization of functions like Either's `Data.Either.Extra.mapLeft` and `Data.Either.Extra.mapRight`.
+--
+-- If you want to map a polymorphic function like `show` which could match more than one possibility,
+-- use a TypeApplication to specify the desired possibility to match:
+--
+-- >>> :{
+-- (Vary.from @Int 42           :: Vary [Int, Bool] )
+--   & Vary.mapOn @Bool show    -- Vary [Int, String]
+--   & Vary.mapOn @Int show     -- Vary [String, String]
+-- :}
+-- Vary.from @[Char] "42"
+--
+-- If you end up with a variant with multiple duplicate possibilities, use `morph` to join them:
+--
+-- >>> :{
+-- (Vary.from True                :: Vary [Char, Int, Bool])
+--   & Vary.mapOn @Bool show      -- Vary [Char, Int, String]
+--   & Vary.mapOn @Int show       -- Vary [Char, String, String]
+--   & Vary.mapOn @Char show      -- Vary [String, String, String]
+--   & Vary.morph @'[String]       -- Vary '[String]
+--   & Vary.intoOnly              -- String
+-- :}
+-- "True"
+
+-- Note that if you end up handling all cases of a variant, you might prefer using `Vary.on` and `Vary.exhaustiveCase` instead.
+--
+-- == Generic code
+--
+-- It is possible to use the most general type of this function in your own signatures;
+-- To do this, add the `Mappable` constraint (exposed from `Vary.Utils`)
+-- to relate the input variant with the output variant.
+--
+-- >>> import qualified Data.Char
+-- >>> :{
+-- example4 :: (Vary.Utils.Mappable Int Bool xs ys, Vary.Utils.Mappable Char Int ys zs) => Vary xs -> Vary zs
+-- example4 vary =
+--   vary
+--   & Vary.mapOn @Int (\x -> x > 0)
+--   & Vary.mapOn @Char Data.Char.ord
+-- :}
+--
+-- == Duplicate possibilities
+-- Vary.mapOn will only work on the first instance of the type that is encountered.
+-- This is only a problem if a possibility is in the list multiple times;
+-- be sure to `Vary.morph` duplicate possibilities away if needed.
+mapOn :: forall a b xs ys. Mappable a b xs ys => (a -> b) -> Vary xs -> Vary ys
+mapOn fun vary@(Vary tag val) =
+  case into @a vary of
+    Just a -> from @b (fun a)
+    Nothing -> (Vary tag val)
diff --git a/cardano-cli/src/Cardano/CLI/Vary/Core.hs b/cardano-cli/src/Cardano/CLI/Vary/Core.hs
new file mode 100644
index 0000000000..96680cf298
--- /dev/null
+++ b/cardano-cli/src/Cardano/CLI/Vary/Core.hs
@@ -0,0 +1,416 @@
+{-
+
+Copyright © 2024 Marten Wijnja (Qqwy)
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the “Software”), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+of the Software, and to permit persons to whom the Software is furnished to do
+so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+
+-}
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE EmptyCase #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
+{-# OPTIONS_HADDOCK not-home #-}
+
+module Cardano.CLI.Vary.Core (Vary (..), pop) where
+
+import Control.Applicative ((<|>))
+import Control.DeepSeq (NFData (..))
+import Control.Exception (Exception (..))
+import Data.Kind (Type)
+import Data.Typeable (Typeable, typeOf)
+import GHC.Exts (Any)
+import GHC.Generics
+import qualified Unsafe.Coerce as Data.Coerce
+
+# ifdef FLAG_AESON
+import qualified Data.Aeson as Aeson
+# endif
+
+# ifdef FLAG_HASHABLE
+import Data.Hashable
+# endif
+
+# ifdef FLAG_QUICKCHECK
+import Test.QuickCheck
+import Test.QuickCheck.Arbitrary (GSubterms, RecursivelyShrink)
+# endif
+
+# ifdef FLAG_BINARY
+import qualified Data.Binary as Binary
+# endif
+
+# ifdef FLAG_CEREAL
+import qualified Data.Serialize as Cereal
+# endif
+
+-- $setup
+-- >>> :set -XDataKinds
+-- >>> import Cardano.CLI.Vary (Vary, (:|))
+-- >>> import qualified Vary
+
+-- | Vary, contains one value out of a set of possibilities
+--
+-- Vary is what is known as a /Variant/ type.
+-- This is also known as an /open union/ or /coproduct/, among other names.
+--
+-- You can see it as the generalization of `Either`.
+-- Conceptually, these are the same:
+--
+-- > Vary [a, b, c, d, e]
+-- > Either a (Either b (Either c (Either d e)))
+--
+-- However, compared to a deeply nested `Either`, `Vary` is:
+--
+-- - Much easier to work with;
+-- - Much more efficient, as a single (strict) word is used for the tag.
+--
+-- `Vary`'s can be constructed with "Vary".`Vary.from` and values can be extracted using "Vary".`Vary.into` and "Vary".'Vary.on' .
+data Vary (possibilities :: [Type]) = Vary {-# UNPACK #-} !Word Any
+
+emptyVaryError :: forall anything. String -> Vary '[] -> anything
+emptyVaryError name = error (name <> " was called on empty Vary '[]")
+
+-- | Attempts to extract a value of the first type from the `Vary`.
+--
+-- If this failed, we know it has to be one of the other possibilities.
+--
+-- This function can also be seen as turning one layer of `Vary` into its isomorphic `Either` representation.
+--
+-- This function is not often useful in 'normal' code, but /super/ useful in generic code where you want to recurse on the variant's types.
+--
+-- For instance when implementing a typeclass for any `Vary` whose elements implement the typeclass:
+--
+--
+-- > instance Show (Vary '[]) where
+-- >    show = Vary.exhaustiveCase
+-- >
+-- > instance (Show a, Show (Vary as)) => Show (Vary (a : as)) where
+-- >    show vary = case Vary.pop vary of
+-- >        Right val -> "Vary.from " <> show val
+-- >        Left other -> show other
+--
+-- To go the other way:
+--
+-- - Use "Vary".`Vary.morph` to turn @Vary as@ back into @Vary (a : as)@
+-- - Use "Vary".`Vary.from` to turn @a@ back into @Vary (a : as)@
+pop :: Vary (a : as) -> Either (Vary as) a
+{-# INLINE pop #-}
+pop (Vary 0 val) = Right (Data.Coerce.unsafeCoerce val)
+pop (Vary tag inner) = Left (Vary (tag - 1) inner)
+
+pushHead :: a -> Vary (a : as)
+{-# INLINE pushHead #-}
+pushHead val = Vary 0 (Data.Coerce.unsafeCoerce val)
+
+{-# INLINE pushTail #-}
+pushTail :: Vary as -> Vary (a : as)
+pushTail (Vary tag inner) = Vary (tag + 1) inner
+
+instance Eq (Vary '[]) where
+  (==) = emptyVaryError "Eq.(==)"
+
+instance (Eq a, Eq (Vary as)) => Eq (Vary (a : as)) where
+  {-# INLINE (==) #-}
+  a == b = pop a == pop b
+
+instance Ord (Vary '[]) where
+  compare = emptyVaryError "Ord.compare"
+
+instance (Ord a, Ord (Vary as)) => Ord (Vary (a : as)) where
+  {-# INLINE compare #-}
+  l `compare` r = pop l `compare` pop r
+
+instance Show (Vary '[]) where
+  show = emptyVaryError "Show.show"
+
+-- | `Vary`'s 'Show' instance only works for types which are 'Typeable'
+--
+-- This allows us to print the name of the type which
+-- the current value is of.
+--
+-- >>> Vary.from @Bool True :: Vary '[Int, Bool, String]
+-- Vary.from @Bool True
+--
+-- >>> Vary.from @(Maybe Int) (Just 1234) :: Vary '[Maybe Int, Bool]
+-- Vary.from @(Maybe Int) (Just 1234)
+instance (Typeable a, Show a, Show (Vary as)) => Show (Vary (a : as)) where
+  showsPrec d vary = case pop vary of
+    Right val ->
+      showString "Vary.from "
+        . showString "@"
+        . showsPrec (d + 10) (typeOf val)
+        . showString " "
+        . showsPrec (d + 11) val
+    Left other -> showsPrec d other
+
+instance NFData (Vary '[]) where
+  rnf = emptyVaryError "NFData.rnf"
+
+instance (NFData a, NFData (Vary as)) => NFData (Vary (a : as)) where
+  {-# INLINE rnf #-}
+  rnf vary = rnf (pop vary)
+
+instance (Typeable (Vary '[]), Show (Vary '[])) => Exception (Vary '[])
+
+-- | See [Vary and Exceptions](#vary_and_exceptions) for more info.
+instance (Exception e, Exception (Vary errs), Typeable errs) => Exception (Vary (e : errs)) where
+  displayException vary =
+    either displayException displayException (pop vary)
+
+  toException vary =
+    either toException toException (pop vary)
+
+  fromException ex =
+    (pushHead <$> fromException @e ex) <|> (pushTail <$> fromException @(Vary errs) ex)
+
+-- case fromException @e some_exception of
+--     Just e -> Just (pushHead e)
+--     Nothing ->
+--       case fromException @(Vary errs) some_exception of
+--         Just vary -> Just (pushTail vary)
+--         Nothing -> Nothing
+
+-- Behold! A manually-written Generic instance!
+--
+-- This instance is very similar to the one for tuples (), (,), (,,), ...
+-- but with each occurrence of :*: replaced by :+:
+-- (and using `V1` instead of `U1` for the empty Vary)
+type family RepHelper (list :: [Type]) :: Type -> Type where
+  RepHelper '[] = V1
+  RepHelper '[a] =
+    S1
+      ( MetaSel
+          Nothing
+          NoSourceUnpackedness
+          NoSourceStrictness
+          DecidedLazy
+      )
+      (K1 R a)
+  RepHelper (a : b : bs) =
+    S1
+      (MetaSel Nothing NoSourceUnpackedness NoSourceStrictness DecidedLazy)
+      (Rec0 a)
+      :+: RepHelper (b : bs)
+
+class GenericHelper (list :: [Type]) where
+  fromHelper :: Vary list -> (RepHelper list) x
+  toHelper :: (RepHelper list) x -> Vary list
+
+instance GenericHelper '[] where
+  fromHelper = emptyVaryError "Generic.from"
+  toHelper void = case void of {}
+
+instance GenericHelper '[a] where
+  fromHelper vary = case pop vary of
+    Right val -> M1 $ K1 $ val
+    Left empty -> emptyVaryError "Generic.from" empty
+
+  toHelper (M1 (K1 val)) = pushHead val
+
+instance (GenericHelper (b : bs)) => GenericHelper (a : b : bs) where
+  fromHelper vary = case pop vary of
+    Right val -> L1 $ M1 $ K1 $ val
+    Left rest -> R1 $ fromHelper rest
+
+  toHelper (L1 (M1 (K1 val))) = pushHead val
+  toHelper (R1 rest) = pushTail (toHelper rest)
+
+-- | Vary '[] 's generic representation is `V1`.
+instance Generic (Vary '[]) where
+  type
+    Rep (Vary '[]) =
+      D1
+        (MetaData "Vary" "Vary" "vary" False)
+        (RepHelper '[])
+  from = emptyVaryError "Generic.from"
+  to void = case void of {}
+
+-- | Any non-empty Vary's generic representation is encoded similar to a tuple but with `:+:` instead of `:*:`.
+instance (GenericHelper (a : as)) => Generic (Vary (a : as)) where
+  type
+    Rep (Vary (a : as)) =
+      D1
+        (MetaData "Vary" "Vary" "vary" False)
+        ( C1
+            (MetaCons "from" PrefixI False)
+            (RepHelper (a : as))
+        )
+  from vary = M1 $ M1 $ fromHelper vary
+  to (M1 (M1 gval)) = toHelper gval
+
+# ifdef FLAG_AESON
+deriving instance Aeson.FromJSON (Vary '[])
+
+deriving instance (Aeson.FromJSON a) => Aeson.FromJSON (Vary '[a])
+
+-- | This instance round-trips iff there is no overlap between the encodings of the element types.
+--
+-- For example, a `Vary '[Int, String] is round-trippable
+-- but a `Vary '[String, Char]` is not.
+instance (Aeson.FromJSON a, Aeson.FromJSON (Vary (b : bs))) => Aeson.FromJSON (Vary (a : b : bs)) where
+  {-# INLINE parseJSON #-}
+  parseJSON val = (pushHead <$> Aeson.parseJSON val) <|> (pushTail <$> Aeson.parseJSON val)
+
+deriving instance Aeson.ToJSON (Vary '[])
+
+deriving instance (Aeson.ToJSON a) => Aeson.ToJSON (Vary '[a])
+
+-- | This instance round-trips iff there is no overlap between the encodings of the element types.
+--
+-- For example, a `Vary '[Int, String] is round-trippable
+-- but a `Vary '[String, Char]` is not.
+instance (Aeson.ToJSON a, Aeson.ToJSON (Vary (b : bs))) => Aeson.ToJSON (Vary (a : b : bs)) where
+  {-# INLINE toJSON #-}
+  toJSON vary =
+    either Aeson.toJSON Aeson.toJSON (pop vary)
+
+  {-# INLINE toEncoding #-}
+  toEncoding vary =
+    either Aeson.toEncoding Aeson.toEncoding (pop vary)
+# endif
+
+# ifdef FLAG_QUICKCHECK
+instance (Test.QuickCheck.Arbitrary a) => Test.QuickCheck.Arbitrary (Vary '[a]) where
+  arbitrary = pushHead <$> arbitrary
+  shrink = genericShrink
+
+instance
+  ( Arbitrary a,
+    Arbitrary (Vary (b : bs)),
+    Generic (Vary (a : b : bs)),
+    RecursivelyShrink (Rep (Vary (a : b : bs))),
+    GSubterms (Rep (Vary (a : b : bs))) (Vary (a : b : bs))
+  ) =>
+  Test.QuickCheck.Arbitrary (Vary (a : b : bs))
+  where
+  arbitrary = oneof [pushHead <$> arbitrary, pushTail <$> arbitrary]
+  shrink = genericShrink
+# endif
+
+#ifdef FLAG_HASHABLE
+class FastHashable a where
+  badHashWithSalt :: Int -> a -> Int
+
+instance (Hashable a) => FastHashable (Vary '[a]) where
+  {-# INLINE badHashWithSalt #-}
+  badHashWithSalt salt vary = case pop vary of
+    Right val -> hashWithSalt salt val
+    Left empty -> emptyVaryError "hashWithSalt" empty
+
+instance (Hashable a, FastHashable (Vary (b : bs))) => FastHashable (Vary (a : b : bs)) where
+  {-# INLINE badHashWithSalt #-}
+  badHashWithSalt salt vary = case pop vary of
+    Right val -> hashWithSalt salt val
+    Left rest -> badHashWithSalt salt rest
+
+instance
+  ( Eq (Vary (a : as)),
+    FastHashable (Vary (a : as))
+  ) =>
+  Hashable (Vary (a : as))
+  where
+  hashWithSalt salt vary@(Vary tag _inner) = fromIntegral tag `hashWithSalt` badHashWithSalt salt vary
+  hash vary@(Vary tag _inner) = badHashWithSalt (fromIntegral tag) vary
+#endif
+
+#ifdef FLAG_BINARY
+class BinaryHelper a where
+  binaryPutVariant :: a -> Binary.Put
+  binaryGetVariant :: Word -> Binary.Get a
+
+instance BinaryHelper (Vary '[]) where
+  {-# INLINE binaryPutVariant #-}
+  binaryPutVariant emptyVary = case from emptyVary of {}
+
+  {-# INLINE binaryGetVariant #-}
+  binaryGetVariant = emptyVaryError "binaryGetVariant" undefined
+
+instance
+  ( Binary.Binary a
+  , BinaryHelper (Vary as)
+  ) =>
+  BinaryHelper (Vary (a : as))
+  where
+  {-# INLINE binaryPutVariant #-}
+  binaryPutVariant vary = case pop vary of
+    Right val -> Binary.put val
+    Left val -> binaryPutVariant val
+
+  {-# INLINE binaryGetVariant #-}
+  binaryGetVariant 0 = pushHead <$> Binary.get @a
+  binaryGetVariant n = pushTail <$> binaryGetVariant @(Vary as) (n - 1)
+
+instance (BinaryHelper (Vary as)) => Binary.Binary (Vary as) where
+  {-# INLINE put #-}
+  put vary@(Vary n _) = do
+    Binary.put n
+    binaryPutVariant vary
+  {-# INLINE get #-}
+  get = do
+    tag <- Binary.get
+    binaryGetVariant tag
+#endif
+
+#ifdef FLAG_CEREAL
+class SerializeHelper a where
+  cerealPutVariant :: a -> Cereal.Put
+  cerealGetVariant :: Word -> Cereal.Get a
+
+instance SerializeHelper (Vary '[]) where
+  {-# INLINE cerealPutVariant #-}
+  cerealPutVariant emptyVary = case from emptyVary of {} 
+  {-# INLINE cerealGetVariant #-}
+  cerealGetVariant = emptyVaryError "cerealGetVariant" undefined
+
+instance
+  ( Cereal.Serialize a
+  , SerializeHelper (Vary as)
+  ) =>
+  SerializeHelper (Vary (a : as))
+  where
+  {-# INLINE cerealPutVariant #-}
+  cerealPutVariant vary = case pop vary of
+    Right val -> Cereal.put val
+    Left val -> cerealPutVariant val
+
+  {-# INLINE cerealGetVariant #-}
+  cerealGetVariant 0 = pushHead <$> Cereal.get @a
+  cerealGetVariant n = pushTail <$> cerealGetVariant @(Vary as) (n - 1)
+
+instance (SerializeHelper (Vary as)) => Cereal.Serialize (Vary as) where
+  {-# INLINE put #-}
+  put vary@(Vary n _) = do
+    Cereal.putWord64le (fromIntegral n)
+    cerealPutVariant vary
+  {-# INLINE get #-}
+  get = do
+    tag <- Cereal.getWord64le
+    cerealGetVariant (fromIntegral tag)
+#endif
diff --git a/cardano-cli/src/Cardano/CLI/Vary/Utils.hs b/cardano-cli/src/Cardano/CLI/Vary/Utils.hs
new file mode 100644
index 0000000000..ea64dc1e12
--- /dev/null
+++ b/cardano-cli/src/Cardano/CLI/Vary/Utils.hs
@@ -0,0 +1,282 @@
+{-
+
+Copyright © 2024 Marten Wijnja (Qqwy)
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the “Software”), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+of the Software, and to permit persons to whom the Software is furnished to do
+so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+
+-}
+{-# HLINT ignore "Use camelCase" #-}
+-- <- We want a fun long type name with underscores for easier to read errors ;-)
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilyDependencies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
+
+module Cardano.CLI.Vary.Utils
+  ( -- |
+    -- This module contains functions and typeclasses/type families (type-level functions)
+    -- that are not useful in every day usage,
+    -- but are sometimes _very_ useful in:
+    --
+    -- - highly generic code
+    -- - When you want to implement typeclasses for 'Vary'.
+    -- - When you want to have access to the internals of Vary to debug something
+
+    -- * Useful in generic code and when implementing typeclasses
+    (:|)
+  , Subset (..)
+  , Mappable
+  , Length
+  , Index
+  , IndexOf
+  , pop
+
+    -- * Informational (for Debugging)
+  , size
+  , activeIndex
+
+    -- * Helper functions
+  , natValue
+  )
+where
+
+import Cardano.CLI.Vary.Core (Vary (..), pop)
+
+import Data.Kind (Constraint, Type)
+import Data.Proxy (Proxy (..))
+import GHC.TypeLits
+  ( ErrorMessage (ShowType, Text, (:$$:), (:<>:))
+  , KnownNat
+  , Nat
+  , TypeError
+  , natVal
+  , type (+)
+  , type (-)
+  )
+
+-- | Constrain `es` to be any type list containing `e`.
+--
+-- Useful to talk about variants generically without having to specify the exact type list right away.
+--
+-- For instance, the type of `Vary.from` is
+--
+-- > Vary.from :: (a :| l) => a -> Vary l
+--
+-- because we can use it to construct /any/ Vary as long as there is an @a@ somewhere in its list of types.
+type (:|) e es = Member e es
+
+-- | Returns the number of elements contained in this variant.
+--
+-- Does not actually use the runtime representation of the variant in any way.
+size :: forall xs. KnownNat (Length xs) => Vary xs -> Word
+size _ = natValue @(Length xs)
+
+-- | Returns the currently active 'tag index' of the variant.
+--
+-- Not useful in normal code, but maybe nice in certaing debugging scenarios.
+--
+-- Note that this index changes whenever a variant is `Vary.morph`ed.
+activeIndex :: Vary a -> Word
+activeIndex (Vary idx _) = idx
+
+-- | Provide evidence that @xs@ is a subset of @es@.
+--
+-- This is used to make 'Vary.morph' and 'Vary.VEither.morph' work.
+class KnownPrefix es => Subset (xs :: [Type]) (es :: [Type]) where
+  subsetFullyKnown :: Bool
+  subsetFullyKnown =
+    -- Don't show "minimal complete definition" in haddock.
+    error "subsetFullyKnown"
+
+  morph' :: Vary xs -> Vary ys
+  morph' =
+    -- Don't show "minimal complete definition" in haddock.
+    -- Also, default for the empty instance :-)
+    error "morph' was unexpectedly called"
+
+-- If the subset is not fully known, make sure the subset and the base stack
+-- have the same unknown suffix.
+instance
+  {-# INCOHERENT #-}
+  ( KnownPrefix es
+  , xs `IsUnknownSuffixOf` es
+  )
+  => Subset xs es
+  where
+  subsetFullyKnown = False
+
+-- If the subset is fully known, we're done.
+instance KnownPrefix es => Subset '[] es where
+  subsetFullyKnown = True
+
+instance (e :| es, Subset xs es) => Subset (e : xs) es where
+  subsetFullyKnown = subsetFullyKnown @xs @es
+
+  morph' (Vary 0 a) = Vary (natValue @(IndexOf e es)) a
+  morph' (Vary n a) = morph' @xs @es (Vary (n - 1) a)
+
+----
+
+-- | Calculate length of a statically known prefix of @es@.
+--
+-- Used as part of `Subset`.
+class KnownPrefix (es :: [Type]) where
+  prefixLength :: Int
+
+instance KnownPrefix es => KnownPrefix (e : es) where
+  prefixLength = 1 + prefixLength @es
+
+instance {-# INCOHERENT #-} KnownPrefix es where
+  prefixLength = 0
+
+----
+
+-- | Require that @xs@ is the unknown suffix of @es@.
+--
+-- Used as part of `Subset`.
+class (xs :: [k]) `IsUnknownSuffixOf` (es :: [k])
+
+instance {-# INCOHERENT #-} xs ~ es => xs `IsUnknownSuffixOf` es
+
+instance xs `IsUnknownSuffixOf` es => xs `IsUnknownSuffixOf` (e : es)
+
+-- | Type-level function to compute the length of a type-level list
+type family Length (xs :: [k]) :: Nat where
+  Length xs = Length' 0 xs
+
+type family Length' n (xs :: [k]) :: Nat where
+  Length' n '[] = n
+  Length' n (x ': xs) = Length' (n + 1) xs
+
+-- | A slight generalization of 'GHC.TypeLits.natVal' to return arbitrary 'Num'.
+--
+-- (List indexes are never negative, after all.)
+natValue :: forall (n :: Nat) a. (KnownNat n, Num a) => a
+{-# INLINEABLE natValue #-}
+natValue = fromIntegral (natVal (Proxy :: Proxy n))
+
+-- | Constraint to link the input and output lists together, without specifying any particular element order.
+--
+-- This allows us to defer type signatures until the final place the variant is used.
+type Mappable a b xs ys = (a :| xs, b :| ys, ys ~ Mapped a b xs)
+
+-- | Compute a HList where the type a was changed into b.
+type family Mapped (a :: Type) (b :: Type) (as :: [Type]) = (bs :: [Type]) where
+  Mapped a b (a ': as) = (b ': as)
+  Mapped a b (x ': as) = x ': Mapped a b as
+  Mapped a b l =
+    TypeError
+      ( 'Text "Cannot map from " ':<>: 'ShowType a ':<>: 'Text " into " ':<>: 'ShowType b
+          :$$: 'Text "as it cannot be found in the list " ':<>: 'ShowType l
+      )
+
+-- | Look up the index a particular type has in a type-level-list.
+--
+-- This index is what is used to determine the tag value stored in a 'Vary'.
+type IndexOf (x :: k) (xs :: [k]) = IndexOf' (MaybeIndexOf x xs) x xs
+
+-- | Get the first index of a type
+type family IndexOf' (i :: Nat) (a :: k) (l :: [k]) :: Nat where
+  IndexOf' 0 x l =
+    TypeError
+      ( 'ShowType x
+          ':<>: 'Text " not found in list:"
+          ':$$: 'Text " "
+            ':<>: 'ShowType l
+      )
+  IndexOf' i _ _ = i - 1
+
+-- | Get the first index (starting from 1) of a type or 0 if none
+type family MaybeIndexOf (a :: k) (l :: [k]) where
+  MaybeIndexOf x xs = MaybeIndexOf' 0 x xs
+
+-- | Helper for MaybeIndexOf
+type family MaybeIndexOf' (n :: Nat) (a :: k) (l :: [k]) where
+  MaybeIndexOf' n x '[] = 0
+  MaybeIndexOf' n x (x ': xs) = n + 1
+  MaybeIndexOf' n x (y ': xs) = MaybeIndexOf' (n + 1) x xs
+
+-- | Given a type-level index, look up the type at that index.
+--
+-- If you ever see the @Type_List_Too_Vague...@ in a type error,
+-- it means that you need to make the (prefix) of the list of types more concrete
+-- by adding some type annotations somewhere.
+type Index (n :: Nat) (l :: [k]) =
+  Type_List_Too_Vague___Please_Specify_Prefix_Of_List_Including_The_Desired_Type's_Location n l l
+
+-- | We use this ridiculous name
+-- to make it clear to the user when they see it in a type error
+-- how to resolve that type error.
+type family
+  Type_List_Too_Vague___Please_Specify_Prefix_Of_List_Including_The_Desired_Type's_Location
+    (n :: Nat)
+    (l :: [k])
+    (l2 :: [k])
+    :: k
+  where
+  Type_List_Too_Vague___Please_Specify_Prefix_Of_List_Including_The_Desired_Type's_Location
+    0
+    (x ': _)
+    _ =
+    x
+  Type_List_Too_Vague___Please_Specify_Prefix_Of_List_Including_The_Desired_Type's_Location
+    n
+    (_ ': xs)
+    l2 =
+    Type_List_Too_Vague___Please_Specify_Prefix_Of_List_Including_The_Desired_Type's_Location
+      (n - 1)
+      xs
+      l2
+  Type_List_Too_Vague___Please_Specify_Prefix_Of_List_Including_The_Desired_Type's_Location
+    n
+    '[]
+    l2 =
+    TypeError
+      ( 'Text "Index "
+          ':<>: 'ShowType n
+          ':<>: 'Text " out of bounds for list:"
+          ':$$: 'Text " "
+            ':<>: 'ShowType l2
+      )
+
+-- | Constraint: x member of xs
+type family Member x xs :: Constraint where
+  Member x xs = MemberAtIndex (IndexOf x xs) x xs
+
+type MemberAtIndex i x xs =
+  ( x ~ Index i xs
+  , KnownNat i
+  )
+
+-- | Remove (the first) `a` in `l`
+type family Remove (a :: k) (l :: [k]) :: [k] where
+  Remove a '[] = '[]
+  Remove a (a ': as) = as
+  Remove a (b ': as) = b ': Remove a as
diff --git a/cardano-cli/src/Cardano/CLI/Vary/VEither.hs b/cardano-cli/src/Cardano/CLI/Vary/VEither.hs
new file mode 100644
index 0000000000..6d62f7ca68
--- /dev/null
+++ b/cardano-cli/src/Cardano/CLI/Vary/VEither.hs
@@ -0,0 +1,406 @@
+{-
+
+Copyright © 2024 Marten Wijnja (Qqwy)
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the “Software”), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+of the Software, and to permit persons to whom the Software is furnished to do
+so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+
+-}
+{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module Cardano.CLI.Vary.VEither (
+  -- * General Usage
+  -- $setup
+
+  -- * Core type definition
+  VEither(VLeft, VRight), 
+  -- * Conversion
+  toVary, 
+  fromVary,
+  fromLeft,
+  fromRight,
+  toEither,
+  fromEither,
+  veither,
+  intoOnly,
+
+  -- * case analysis ("pattern matching"):
+
+  -- |
+  --
+  -- Besides the 'VLeft' and 'VRight' patterns,
+  -- 'VEither' supports a bunch of handy combinator functions,
+  -- similar to "Vary".'Vary.on' and co.
+  onLeft,
+  onRight,
+  handle,
+
+  -- * Transforming
+  mapLeftOn,
+  mapLeft,
+  mapRight,
+  morph,
+  morphed,
+) where
+
+import Control.Category ((>>>))
+import Control.DeepSeq (NFData (..))
+import qualified Data.Either
+import Data.Kind (Type)
+import Cardano.CLI.Vary.Core (Vary(..))
+import Cardano.CLI.Vary.Utils (Subset, Mappable)
+import Cardano.CLI.Vary ((:|))
+import Cardano.CLI.Vary qualified as Vary
+import GHC.Generics
+
+# ifdef FLAG_AESON
+import qualified Data.Aeson as Aeson
+# endif
+
+# ifdef FLAG_HASHABLE
+import Data.Hashable
+# endif
+
+# ifdef FLAG_QUICKCHECK
+import Test.QuickCheck
+# endif
+
+# ifdef FLAG_CEREAL
+import qualified Data.Serialize as Cereal
+# endif
+
+# ifdef FLAG_BINARY
+import qualified Data.Binary as Binary
+# endif
+
+-- $setup
+--
+-- This module is intended to be used qualified:
+--
+-- >>> import Cardano.CLI.Vary.VEither (VEither(VLeft, VRight))
+-- >>> import qualified Vary.VEither as VEither
+-- 
+-- And for many functions, it is useful or outright necessary to enable the following extensions:
+--
+-- >>> :set -XDataKinds
+--
+-- Finally, some example snippets in this module make use of 'Data.Function.&', the left-to-right function application operator.
+--
+-- >>> import Data.Function ((&))
+
+
+newtype VEither (errs :: [Type]) a = VEither (Vary (a : errs))
+
+-- | Turns the 'VEither' into a normal Vary, no longer considering the @a@ a \'preferred\' value.
+--
+-- In many cases, you probably want to mattern match on "VEither".'VLeft' instead!
+toVary :: VEither errs a -> Vary (a : errs)
+{-# INLINE toVary #-}
+toVary (VEither vary) = vary
+
+-- | Turns a 'Vary' into a 'VEither'. Now the @a@ is considered the \'preferred\' value.
+--
+-- In many cases, you probably want to use "VEither".'VLeft' instead!
+fromVary :: Vary (a : errs) -> VEither errs a
+{-# INLINE fromVary #-}
+fromVary vary = VEither vary
+
+-- | Turns a 'VEither' into a normal 'Either'.
+toEither :: VEither errs a -> Either (Vary errs) a
+{-# INLINE toEither #-}
+toEither = toVary >>> Vary.pop
+
+-- | Turns a normal 'Either' into a 'VEither'.
+fromEither :: Either (Vary errs) a -> VEither errs a
+{-# INLINE fromEither #-}
+fromEither = Data.Either.either Vary.morph Vary.from >>> fromVary
+
+-- | Shorthand to construct a 'VEither' from a single error value.
+--
+-- Instead of:
+--
+-- >>> (VLeft (Vary.from @Bool True)) :: VEither '[Bool] String
+-- VLeft (Vary.from @Bool True) 
+--
+-- You can just write:
+--
+-- >>> VEither.fromLeft @Bool True :: VEither '[Bool] String
+-- VLeft (Vary.from @Bool True) 
+fromLeft :: forall err errs a. err :| errs => err -> VEither errs a
+{-# INLINE fromLeft #-}
+fromLeft = Vary.from @err >>> VLeft
+
+-- | Construct a 'VEither' from an @a@.
+--
+-- Exists for symmetry with 'fromLeft'.
+-- Indeed, this is just another name for 'VRight' (and for 'pure').
+fromRight :: forall a errs. a -> VEither errs a
+{-# INLINE fromRight #-}
+fromRight = VRight
+
+-- | Case analysis on a 'VEither'. Similar to 'Data.Either.either'.
+--
+-- See also "VEither".'mapLeft', "VEither".'mapLeftOn' and "VEither".'mapRight'.
+veither :: (Vary errs -> c) -> (a -> c) -> VEither errs a -> c
+{-# INLINE veither #-}
+veither f _ (VLeft x)     =  f x
+veither _ g (VRight y)    =  g y
+
+{-# COMPLETE VLeft, VRight #-}
+
+-- Matches when the VEither contains one of the errors, returning @Vary errs@
+pattern VLeft :: forall a errs. Vary errs -> VEither errs a
+#if __GLASGOW_HASKELL__ >= 902
+{-# INLINE VLeft #-}
+#endif
+pattern VLeft errs <- (toEither -> Left errs)
+   where
+      VLeft (Vary tag err) = VEither ((Vary (tag+1) err))
+
+-- | Matches when the VEither contains the preferred value of type @a@.
+pattern VRight :: forall a errs. a -> VEither errs a
+#if __GLASGOW_HASKELL__ >= 902
+{-# INLINE VRight #-}
+#endif
+pattern VRight a <- (toEither -> Right a)
+  where
+    VRight a = VEither (Vary.from @a a)
+
+-- | Handle a particular error possibility.
+--
+-- Works very similarly to "Vary".'Vary.on'.
+onLeft :: forall err b errs a. (err -> b) -> (VEither errs a -> b) -> VEither (err : errs) a -> b
+{-# INLINE onLeft #-}
+onLeft thiserrFun restfun ve = case ve of
+  VLeft e -> Vary.on @err thiserrFun (\otherErr -> restfun (VLeft otherErr)) e
+  VRight a -> restfun (VRight a)
+
+-- | Handle the success posibility.
+--
+--
+-- Works very similarly to "Vary".'Vary.on'.
+-- Usually used together with "VError".'onLeft'.
+onRight :: (a -> b) -> (VEither errs a -> b) -> VEither errs a -> b
+{-# INLINE onRight #-}
+onRight valfun restfun ve = case ve of
+  VRight a -> valfun a
+  VLeft err -> restfun (VLeft err)
+
+-- | Handle a single error, by mapping it either to the success type @a@ or to one of the other errors in @errs@.
+--
+-- This is syntactic sugar over using "VEither".'onLeft',
+-- but can be nicer to use if one or only a few error variants need to be handled,
+-- because it lets you build a simple pipeline:
+--
+-- >>> :{
+--  examplePipe ve = ve
+--    & VEither.handle @Int (pure . show) 
+--    & VEither.handle @Bool (pure . show)
+-- :}
+--
+-- >>> :t examplePipe
+-- examplePipe 
+--   :: VEither (Int : Bool : errs) String -> VEither errs String
+-- >>> examplePipe (VEither.fromLeft False :: VEither '[Int, Bool, Float] String)
+-- VRight "False"
+handle :: (err -> VEither errs a) -> VEither (err : errs) a -> VEither errs a
+{-# INLINE handle #-}
+handle fun = onLeft fun id
+
+-- | If you have a VEither which does not actually contain any errors,
+-- you can be sure it always contains an @a@.
+--
+-- Similar to "Vary".'Vary.intoOnly'.
+intoOnly :: forall a. VEither '[] a -> a
+{-# INLINE intoOnly #-}
+intoOnly (VRight a) = a
+intoOnly (VLeft emptyVary) = Vary.exhaustiveCase emptyVary
+
+
+-- | Extend a smaller `VEiher` into a bigger one, change the order of its error types, or get rid of duplicate error types.
+--
+-- Similar to "Vary".'Vary.morph'
+morph :: forall ys xs a. Subset (a : xs) (a : ys) => VEither xs a -> VEither ys a
+{-# INLINE morph #-}
+morph = toVary >>> Vary.morph >>> fromVary
+
+-- | Execute a function expecting a larger (or differently-ordered) variant
+-- with a smaller (or differently-ordered) variant,
+-- by calling `morph` on it before running the function.
+morphed :: forall xs ys a res. Subset (a : xs) (a : ys) => (VEither ys a -> res) -> VEither xs a -> res
+{-# INLINE morphed #-}
+morphed fun = fun . morph
+
+-- | Map a function over one of the error values inside the 'VEither'.
+--
+-- Any other 'VLeft' and  also 'VRight' are kept untouched.
+--
+-- Similar to "Vary".'Vary.mapOn'.
+mapLeftOn :: forall x y xs ys a. (Mappable x y xs ys) => (x -> y) -> VEither xs a -> VEither ys a
+{-# INLINE mapLeftOn #-}
+mapLeftOn _ (VRight val) = VRight val
+mapLeftOn fun (VLeft err) = VLeft $ Vary.mapOn fun err
+
+-- | Map a function over the 'VEither' if it contains a 'VLeft', otherwise leave it alone.
+--
+-- See also "VEither".'mapLeftOn', "VEither".'mapRight' and "VEither".'veither'.
+--
+mapLeft :: (Vary xs -> Vary ys) -> VEither xs a -> VEither ys a
+{-# INLINE mapLeft #-}
+mapLeft fun ve = case ve of 
+    VRight a -> VRight a
+    VLeft errs -> VLeft (fun errs)
+
+-- | Map a function over the 'VEither' if it contains a 'VRight', otherwise leave it alone.
+--
+-- Exists for symmetry with "VEither".'mapLeft' and "VEither".'mapLeftOn'.
+--
+-- Indeed, it is just another name for 'fmap'.
+--
+-- See also "VEither".'veither'.
+mapRight :: (x -> y) -> VEither errs x -> VEither errs y
+{-# INLINE mapRight #-}
+mapRight fun ve = case ve of 
+    VRight a -> VRight (fun a)
+    VLeft errs -> VLeft errs
+
+instance (Show a, Show (Vary errs)) => Show (VEither errs a) where
+  show (VLeft errs) = "VLeft (" <> show errs <> ")"
+  show (VRight a) = "VRight " <> show a
+
+instance (Eq a, Eq (Vary errs)) => Eq (VEither errs a) where
+  a == b = toVary a == toVary b
+
+instance (Ord a, Ord (Vary errs)) => Ord (VEither errs a) where
+  compare a b = compare (toVary a) (toVary b)
+
+instance (NFData a, NFData (Vary errs)) => NFData (VEither errs a) where
+  rnf = toVary >>> rnf
+
+instance Functor (VEither errs) where
+  fmap :: forall a b. (a -> b) -> VEither errs a -> VEither errs b
+  {-# INLINE fmap #-}
+  fmap = mapRight
+
+instance Applicative (VEither errs) where
+  {-# INLINE pure #-}
+  pure = VRight
+
+  {-# INLINE (<*>) #-}
+  (VRight fun) <*> (VRight val) = VRight (fun val)
+  (VLeft err) <*> _ = (VLeft err)
+  _ <*> (VLeft err) = (VLeft err)
+
+instance Monad (VEither errs) where
+  (>>=) :: forall a b. VEither errs a -> (a -> VEither errs b) -> VEither errs b
+  (VRight a) >>= fun = fun a
+  (VLeft err) >>= _  = (VLeft err)
+
+instance Foldable (VEither errs) where
+    foldMap _ (VLeft _) = mempty
+    foldMap f (VRight y) = f y
+
+    foldr _ z (VLeft _) = z
+    foldr f z (VRight y) = f y z
+
+    length (VLeft _)  = 0
+    length (VRight _) = 1
+
+instance Traversable (VEither errs) where
+    traverse _ (VLeft x) = pure (VLeft x)
+    traverse f (VRight y) = VRight <$> f y
+
+instance Semigroup (VEither errs a) where
+  (VRight a) <> _ = (VRight a)
+  _ <> b = b
+
+-- Look! A hand-written Generic instance! ;-)
+--
+-- This closely follows the implementation of the normal Either,
+-- and pretends the type truly is built up of VLeft and VRight
+instance Generic (VEither errs a) where
+  type (Rep (VEither errs a)) =  D1
+       (MetaData "VEither" "Vary.VEither" "vary" False)
+       (C1
+          (MetaCons "VLeft" PrefixI False)
+          (S1
+             (MetaSel
+                Nothing NoSourceUnpackedness NoSourceStrictness DecidedLazy)
+             (Rec0 (Vary errs)))
+        :+: C1
+              (MetaCons "VRight" PrefixI False)
+              (S1
+                 (MetaSel
+                    Nothing NoSourceUnpackedness NoSourceStrictness DecidedLazy)
+                 (Rec0 a)))
+
+  from :: VEither errs a -> Rep (VEither errs a) x
+  from ve =
+    case ve of
+      (VLeft err) -> M1 $ L1 $ M1 $ M1 $ K1 err
+      (VRight val) -> M1 $ R1 $ M1 $ M1 $ K1 val
+
+  to :: Rep (VEither errs a) x -> VEither errs a 
+  to rep = case rep of
+    (M1 (L1 (M1 (M1 (K1 err))))) -> VLeft err
+    (M1 (R1 (M1 (M1 (K1 val))))) -> VRight val
+
+
+-- Conceptually VEither is a Bifunctor,
+-- but the kind does not align :-(
+-- p has to be Type -> Type -> Type
+-- But in the case of VEither it is [Type] -> Type -> Type
+--
+-- instance Bifunctor VEither where
+--   first = mapLeft
+--   second = mapRight
+--   bimap = veither
+
+#ifdef FLAG_HASHABLE 
+instance (Hashable a, Hashable (Vary errs), (Eq (VEither errs a))) => Hashable (VEither errs a)
+#endif
+
+#ifdef FLAG_AESON 
+deriving instance Aeson.ToJSON (Vary (a : errs)) => Aeson.ToJSON (VEither errs a)
+deriving instance Aeson.FromJSON (Vary (a : errs)) => Aeson.FromJSON (VEither errs a)
+#endif
+
+#ifdef FLAG_QUICKCHECK
+deriving instance (Arbitrary (Vary (a : errs))) => Test.QuickCheck.Arbitrary (VEither errs a)
+#endif
+
+#ifdef FLAG_CEREAL
+deriving instance (Cereal.Serialize (Vary (a : errs))) => Cereal.Serialize (VEither errs a)
+#endif
+
+#ifdef FLAG_BINARY
+deriving instance (Binary.Binary (Vary (a : errs))) => Binary.Binary (VEither errs a)
+#endif