diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,8 +1,9 @@
 # Changelog for free-category
 
-## Version 0.0.4.3
-- updated for GHC 9.0.1
-- added Control.Category.FreeEffect.runEffCat (thanks to Manuel Bärenz)
+## Version 0.0.4.4
+- Added support for GHC: `9.0`, `9.2`, `9.4`.
+- Dropped support for `GHC-8.6` or earlier.
+- Added ArrChoice a free ArrowChoice.
 
 ## Version 0.0.4.2
 - updated for *GHC 8.10.1*
diff --git a/free-category.cabal b/free-category.cabal
--- a/free-category.cabal
+++ b/free-category.cabal
@@ -1,6 +1,6 @@
 cabal-version:  2.0
 name:           free-category
-version:        0.0.4.3
+version:        0.0.4.4
 synopsis:       efficient data types for free categories and arrows
 description:
   This package provides various data types for free categories, type
@@ -12,7 +12,7 @@
 bug-reports:    https://github.com/coot/free-category/issues
 author:         Marcin Szamotulski
 maintainer:     coot@coot.me
-copyright:      (c) 2018-2021 Marcin Szamotulski
+copyright:      (c) 2018-2022 Marcin Szamotulski
 license:        MPL-2.0
 license-file:   LICENSE
 build-type:     Simple
@@ -23,7 +23,7 @@
     bench/report-O1.md
     bench/report-O2.md
 stability:      experimental
-tested-with:    GHC==8.6.5, GHC==8.8.4, GHC==8.10.4
+tested-with:    GHC==8.8.4, GHC==8.10.7, GHC==9.0.2, GHC==9.2.4, GHC==9.4.2
 
 source-repository head
   type: git
diff --git a/src/Control/Arrow/Free.hs b/src/Control/Arrow/Free.hs
--- a/src/Control/Arrow/Free.hs
+++ b/src/Control/Arrow/Free.hs
@@ -13,6 +13,7 @@
   ( -- * Free arrow
     Arr (Id, Arr, Prod)
   , arrArr
+  , liftArr
   , mapArr
   , foldArr
 
@@ -27,15 +28,15 @@
   , hoistFree2
   , joinFree2
   , bindFree2
+    -- * Free 'ArrowChoice'
+  , Choice (..)
+  , liftArrChoice
+  , foldArrChoice
   ) where
 
 import           Prelude hiding (id, (.))
-import           Control.Arrow (Arrow (..))
+import           Control.Arrow (Arrow (..), ArrowChoice (..), (>>>))
 import           Control.Category (Category (..))
-#if __GLASGOW_HASKELL__ < 804
-import           Data.Monoid (Monoid (..))
-import           Data.Semigroup (Semigroup (..))
-#endif
 
 import           Control.Algebra.Free2
   ( AlgebraType0
@@ -60,6 +61,10 @@
 arrArr :: (b -> c) -> Arr f b c
 arrArr bc = Arr bc Id
 
+liftArr :: f a b
+        -> Arr f a b
+liftArr f = Cons f nilQ
+
 mapArr :: f b c
        -> Arr f a b
        -> Arr f a c
@@ -88,9 +93,6 @@
 
 instance Monoid (Arr f o o) where
     mempty = Id
-#if __GLASGOW_HASKELL__ < 804
-    mappend = (<>)
-#endif
 
 instance Arrow (Arr f) where
   arr       = arrArr
@@ -124,15 +126,15 @@
              -> r a b
       }
 
--- |
--- Isomorphism from @'Arr'@ to @'A'@, which is a specialisation of
+-- | Isomorphism from @'Arr'@ to @'A'@, which is a specialisation of
 -- @'hoistFreeH2'@.
+--
 toA :: Arr f a b -> A f a b
 toA = hoistFreeH2
 {-# INLINE toA #-}
 
--- |
--- Inverse of @'fromA'@, which also is a specialisatin of @'hoistFreeH2'@.
+-- | Inverse of @'fromA'@, which also is a specialisation of @'hoistFreeH2'@.
+--
 fromA :: A f a b -> Arr f a b
 fromA = hoistFreeH2
 {-# INLINE fromA #-}
@@ -146,9 +148,6 @@
 
 instance Monoid (A f o o) where
     mempty = id
-#if __GLASGOW_HASKELL__ < 804
-    mappend = (<>)
-#endif
 
 instance Arrow (A f) where
   arr f = A (\_ -> (arr f))
@@ -168,3 +167,31 @@
 
   codom2  = Proof
   forget2 = Proof
+
+data Choice f a b where
+  NoChoice :: f a b
+           -> Choice f a b
+
+  Choose   :: ArrChoice f a c
+           -> ArrChoice f b c
+           -> Choice f (Either a b) c
+
+type ArrChoice f a b = Arr (Choice f) a b
+
+instance ArrowChoice (Arr (Choice f)) where
+  f +++ g = liftArr $ Choose (f >>> arr Left) (g >>> arr Right)
+
+liftArrChoice :: f a b
+              -> ArrChoice f a b
+liftArrChoice = liftArr . NoChoice
+
+foldArrChoice :: forall f arr a b.
+                 ArrowChoice arr
+              => (forall x y. f x y -> arr x y)
+              -> ArrChoice f a b
+              -> arr a b
+foldArrChoice fun = foldArr fun'
+  where
+    fun' :: Choice f x y -> arr x y
+    fun' (NoChoice f) = fun f
+    fun' (Choose f g) = foldArrChoice fun f ||| foldArrChoice fun g
diff --git a/src/Control/Category/Free.hs b/src/Control/Category/Free.hs
--- a/src/Control/Category/Free.hs
+++ b/src/Control/Category/Free.hs
@@ -11,20 +11,10 @@
 {-# LANGUAGE TypeOperators         #-}
 {-# LANGUAGE TypeFamilies          #-}
 {-# LANGUAGE ViewPatterns          #-}
-#if __GLASGOW_HASKELL__ >= 806
 {-# LANGUAGE QuantifiedConstraints #-}
-#endif
 
 {-# OPTIONS_HADDOCK show-extensions #-}
 
-#if __GLASGOW_HASKELL__ <= 802
--- ghc802 does not infer that 'cons' is used when using a bidirectional
--- pattern
-{-# OPTIONS_GHC -Wno-unused-top-binds    #-}
--- the 'complete' pragma was introduced in ghc804
-{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
-#endif
-
 module Control.Category.Free
     ( -- * Real time Queue
       Queue (ConsQ, NilQ)
@@ -37,7 +27,7 @@
     , foldlQ
     , zipWithQ
 
-      -- * Type alligned list
+      -- * Type aligned list
     , ListTr (..)
     , liftL
     , foldNatL
@@ -83,10 +73,6 @@
                   , bindFree2
                   )
 import           Control.Arrow (Arrow (..), ArrowZero (..), ArrowChoice (..))
-#if __GLASGOW_HASKELL__ < 804
-import           Data.Monoid (Monoid (..))
-import           Data.Semigroup (Semigroup (..))
-#endif
 import           Data.Kind (Type)
 
 import           Control.Category.Free.Internal
@@ -96,8 +82,7 @@
 -- CPS style free categories
 --
 
--- |
--- CPS style encoded free category; one can use @'FreeAlgebra2'@ class
+-- | CPS style encoded free category; one can use @'FreeAlgebra2'@ class
 -- instance:
 --
 -- > liftFree2    @C :: f a b -> C f a b
@@ -115,15 +100,15 @@
 composeC (C g) (C f) = C $ \k -> g k . f k
 {-# INLINE [1] composeC #-}
 
--- |
--- Isomorphism from @'ListTr'@ to @'C'@, which is a specialisation of
+-- | Isomorphism from @'ListTr'@ to @'C'@, which is a specialisation of
 -- @'hoistFreeH2'@.
+--
 toC :: ListTr f a b -> C f a b
 toC = hoistFreeH2
 {-# INLINE toC #-}
 
--- |
--- Inverse of @'fromC'@, which also is a specialisation of @'hoistFreeH2'@.
+-- | Inverse of @'fromC'@, which also is a specialisation of @'hoistFreeH2'@.
+--
 fromC :: C f a b -> ListTr f a b
 fromC = hoistFreeH2
 {-# INLINE fromC #-}
@@ -169,17 +154,10 @@
   id  = C (\_ -> id)
   (.) = composeC
 
-#if __GLASGOW_HASKELL__ >= 806
 -- | Show instance via 'ListTr'
 --
 instance (forall x y. Show (f x y)) => Show (C f a b) where
     show c = show (hoistFreeH2 c :: ListTr f a b)
-#else
--- | Blind show instance via 'ListTr'
---
-instance Show (C f a b) where
-    show c = show (hoistFreeH2 c :: ListTr f a b)
-#endif
 
 type instance AlgebraType0 C f = ()
 type instance AlgebraType  C c = Category c
@@ -212,6 +190,3 @@
 
 instance Monoid (C f o o) where
   mempty = id
-#if __GLASGOW_HASKELL__ < 804
-  mappend = (<>)
-#endif
diff --git a/src/Control/Category/Free/Internal.hs b/src/Control/Category/Free/Internal.hs
--- a/src/Control/Category/Free/Internal.hs
+++ b/src/Control/Category/Free/Internal.hs
@@ -6,23 +6,12 @@
 {-# LANGUAGE RankNTypes            #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeOperators         #-}
 {-# LANGUAGE ViewPatterns          #-}
-
-#if __GLASGOW_HASKELL__ >= 806
 {-# LANGUAGE QuantifiedConstraints #-}
-#endif
 
 {-# OPTIONS_HADDOCK show-extensions #-}
 
-#if __GLASGOW_HASKELL__ <= 802
--- ghc802 does not infer that 'consQ' is used when using a bidirectional
--- pattern
-{-# OPTIONS_GHC -Wno-unused-top-binds    #-}
--- the 'complete' pragma was introduced in ghc804
-{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
-#endif
-
-
 -- | Internal module, contains implementation of type aligned real time queues
 -- (C.Okasaki 'Purely Functional Data Structures').
 --
@@ -56,10 +45,6 @@
 import           Prelude hiding (id, (.))
 import           Control.Arrow
 import           Control.Category (Category (..))
-#if __GLASGOW_HASKELL__ < 804
-import           Data.Monoid (Monoid (..))
-import           Data.Semigroup (Semigroup (..))
-#endif
 import           Data.Kind (Type)
 
 import           Control.Algebra.Free2 ( AlgebraType0
@@ -68,7 +53,7 @@
                                        , Proof (..)
                                        )
 
--- | Oposite categoy in which arrows from @a@ to @b@ are represented by arrows
+-- | Opposite category in which arrows from @a@ to @b@ are represented by arrows
 -- from @b@ to @a@ in the original category.
 --
 newtype Op (f :: k -> k -> Type) (a :: k) (b :: k) = Op { runOp :: f b a }
@@ -95,9 +80,6 @@
 
 instance Category f => Monoid (Op f o o) where
     mempty = id
-#if __GLASGOW_HASKELL__ < 804
-    mappend = (<>)
-#endif
 
 
 --
@@ -208,15 +190,9 @@
     (ConsTr trA' queueA', ConsTr trB' queueB')
                                  -> ConsTr (trA' `fn` trB') (zipWithL fn queueA' queueB')
 
-#if __GLASGOW_HASKELL__ >= 806
 instance (forall (x :: k) (y :: k). Show (f x y)) => Show (ListTr f a b) where
     show NilTr         = "NilTr"
     show (ConsTr x xs) = "ConsTr " ++ show x ++ " " ++ show xs
-#else
-instance Show (ListTr f a b) where
-    show NilTr         = "NilTr"
-    show (ConsTr _ xs) = "ConsTr _ " ++ show xs
-#endif
 
 instance Category (ListTr f) where
   id  = NilTr
@@ -239,9 +215,6 @@
 
 instance Monoid (ListTr f o o) where
   mempty = NilTr
-#if __GLASGOW_HASKELL__ < 804
-  mappend = (<>)
-#endif
 
 instance Arrow f => Arrow (ListTr f) where
   arr ab                          = arr ab `ConsTr` NilTr
@@ -268,7 +241,7 @@
 --
 
 
--- | Type alligned real time queues; Based on `Purely Functinal Data Structures`
+-- | Type aligned real time queues; Based on `Purely Functional Data Structures`
 -- C.Okasaki.  This the most reliably behaved implementation of free categories
 -- in this package.
 --
@@ -292,9 +265,7 @@
 pattern NilQ <- (unconsQ -> EmptyL) where
     NilQ = nilQ
 
-#if __GLASGOW_HASKELL__ > 802
 {-# complete NilQ, ConsQ #-}
-#endif
 
 composeQ :: forall k (f :: k -> k -> Type) x y z.
             Queue f y z
@@ -463,7 +434,6 @@
 
 #-}
 
-#if __GLASGOW_HASKELL__ >= 806
 instance (forall (x :: k) (y :: k). Show (f x y))
       => Show (Queue f a b) where
     show (Queue f r s) =
@@ -473,16 +443,6 @@
         ++ show r
         ++ ") "
         ++ show (lengthListTr s)
-#else
-instance Show (Queue f r s) where
-    show (Queue f r s) =
-        "Queue "
-      ++ show (lengthListTr f)
-      ++ " "
-      ++ show (lengthListTr r)
-      ++ " "
-      ++ show (lengthListTr s)
-#endif
 
 instance Category (Queue f) where
     id  = NilQ
diff --git a/src/Control/Category/FreeEffect.hs b/src/Control/Category/FreeEffect.hs
--- a/src/Control/Category/FreeEffect.hs
+++ b/src/Control/Category/FreeEffect.hs
@@ -27,7 +27,7 @@
 import Data.Algebra.Free (AlgebraType, AlgebraType0, Proof (..))
 
 
--- | Categories which can lift monadic actions, i.e. effectful categories.
+-- | Categories which can lift monadic actions, i.e effectful categories.
 --
 class Category c => EffectCategory c m | c -> m where
   effect :: m (c a b) -> c a b
diff --git a/test/Test/Cat.hs b/test/Test/Cat.hs
--- a/test/Test/Cat.hs
+++ b/test/Test/Cat.hs
@@ -1,6 +1,9 @@
 {-# LANGUAGE CPP                   #-}
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE FlexibleInstances     #-}
+#if __GLASGOW_HASKELL__ >= 902
+{-# LANGUAGE FlexibleContexts      #-}
+#endif
 {-# LANGUAGE GADTs                 #-}
 {-# LANGUAGE KindSignatures        #-}
 {-# LANGUAGE PolyKinds             #-}
@@ -8,9 +11,7 @@
 {-# LANGUAGE TypeApplications      #-}
 {-# LANGUAGE TupleSections         #-}
 {-# LANGUAGE UndecidableInstances  #-}
-#if __GLASGOW_HASKELL__ >= 806
 {-# LANGUAGE QuantifiedConstraints #-}
-#endif
 
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -19,10 +20,6 @@
 import           Prelude hiding ((.), id)
 import           Control.Category
 import           Data.Function (on)
-#if __GLASGOW_HASKELL__ < 804
-import           Data.Monoid (Monoid (..))
-import           Data.Semigroup (Semigroup (..))
-#endif
 import           Text.Show.Functions ()
 import           Numeric.Natural (Natural)
 
@@ -173,7 +170,6 @@
 data ArbListTr where
     ArbListTr :: Eq b => ListTr Tr a b -> Sing a -> Sing b -> ArbListTr
 
-#if __GLASGOW_HASKELL__ >= 806
 instance (forall x y. Show (Tr x y)) => Show ArbListTr where
     show (ArbListTr listTr a b) =
          "ArbListTr "
@@ -182,14 +178,6 @@
       ++ show b
       ++ " "
       ++ show listTr
-#else
-instance Show ArbListTr where
-    show (ArbListTr _listTr a b) =
-         "ArbListTr "
-      ++ show a
-      ++ " -> "
-      ++ show b
-#endif
 
 instance Arbitrary ArbListTr where
     arbitrary = sized $ \n -> do
@@ -281,9 +269,6 @@
 
 instance Monoid (IntCat '() '()) where
     mempty = IntCat 0
-#if __GLASGOW_HASKELL__ < 804
-    mappend = (<>)
-#endif
 
 instance Arbitrary (IntCat '() '()) where
     arbitrary = IntCat <$> arbitrary
