    {-# LANGUAGE CPP #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE AllowAmbiguousTypes #-}
    {-# LANGUAGE TypeApplications #-}
    {-# LANGUAGE UndecidableSuperClasses #-}
    {-# LANGUAGE ConstraintKinds #-}

    -- | Common definitions for MultiGST.Strict and MultiGST.Lazy
    module Control.Monad.Trans.MultiGST.Common
      ( HListM(..)
      , CanReadWrite(..)
      , CanReadWriteFlag(..)
      , HListMContainsImplication
      , HListMContains(..)
      , ContainsReader
      , ContainsState
      , ContainsWriter
      , CanWriteConstraint
      , AppendM
      , HListMReaders
      , AppendMReaders
      , HListMGettableClass(..)
      )
    where

    import Data.Kind (Type)
    import Data.Semigroup
    import qualified Data.HList.HList as HList

    import Control.Monad.Trans.MultiReader.Class
    import Control.Monad.Trans.MultiWriter.Class
    import Control.Monad.Trans.MultiState.Class

    import GHC.Exts (Constraint)

    data CanReadWrite a
      = Gettable a
      | Settable a
      | Tellable a

    data CanReadWriteFlag
      = GettableFlag
      | SettableFlag
      | TellableFlag

    type family HListMContainsImplication (can :: CanReadWriteFlag) t cts :: Constraint where
      HListMContainsImplication 'GettableFlag t cts = ()
      HListMContainsImplication 'TellableFlag t cts = ()
      HListMContainsImplication 'SettableFlag t cts = HListMContains 'GettableFlag t cts

    class HListMContainsImplication can t cts => HListMContains (can :: CanReadWriteFlag) t cts where
      readHListMElem  :: HListM cts -> t
      writeHListMElem :: CanWriteConstraint can => t -> HListM cts -> HListM cts

    type ContainsReader = HListMContains 'GettableFlag
    type ContainsState  = HListMContains 'SettableFlag
    type ContainsWriter = HListMContains 'TellableFlag

    instance
    #if MIN_VERSION_base(4,8,0)
      {-# OVERLAPPING #-}
    #endif
        HListMContains 'GettableFlag x ('Gettable x ': tr) where
      readHListMElem :: HListM ('Gettable x : tr) -> x
    readHListMElem (x :: x
    x :+-: _) = x
    x
    x
      writeHListMElem :: x -> HListM ('Gettable x : tr) -> HListM ('Gettable x : tr)
    writeHListMElem = [Char]
    -> x -> HListM ('Gettable x : tr) -> HListM ('Gettable x : tr)
    forall a. HasCallStack => [Char] -> a
    error "writeHListMElem CanRead"
      -- ghc is too stupid to acknowledge that the constraint cannot be fulfilled..

    instance
    #if MIN_VERSION_base(4,8,0)
      {-# OVERLAPPING #-}
    #endif
        HListMContains 'GettableFlag x ('Settable x ': tr) where
      readHListMElem :: HListM ('Settable x : tr) -> x
    readHListMElem (x :: x
    x :++: _) = x
    x
    x
      writeHListMElem :: x -> HListM ('Settable x : tr) -> HListM ('Settable x : tr)
    writeHListMElem = [Char]
    -> x -> HListM ('Settable x : tr) -> HListM ('Settable x : tr)
    forall a. HasCallStack => [Char] -> a
    error "writeHListMElem CanRead"
      -- ghc is too stupid to acknowledge that the constraint cannot be fulfilled..

    instance HListMContains 'GettableFlag x ts => HListMContains 'GettableFlag x (t ': ts) where
      readHListMElem :: HListM (t : ts) -> x
    readHListMElem (_ :+-: xr :: HListM xr
    xr) = HListM xr -> x
    forall (can :: CanReadWriteFlag) t (cts :: [CanReadWrite *]).
    HListMContains can t cts =>
    HListM cts -> t
    readHListMElem @'GettableFlag HListM xr
    xr
      readHListMElem (_ :-+: xr :: HListM xr
    xr) = HListM xr -> x
    forall (can :: CanReadWriteFlag) t (cts :: [CanReadWrite *]).
    HListMContains can t cts =>
    HListM cts -> t
    readHListMElem @'GettableFlag HListM xr
    xr
      readHListMElem (_ :++: xr :: HListM xr
    xr) = HListM xr -> x
    forall (can :: CanReadWriteFlag) t (cts :: [CanReadWrite *]).
    HListMContains can t cts =>
    HListM cts -> t
    readHListMElem @'GettableFlag HListM xr
    xr
      writeHListMElem :: x -> HListM (t : ts) -> HListM (t : ts)
    writeHListMElem = [Char] -> x -> HListM (t : ts) -> HListM (t : ts)
    forall a. HasCallStack => [Char] -> a
    error "writeHListMElem CanRead"

    instance
    #if MIN_VERSION_base(4,8,0)
      {-# OVERLAPPING #-}
    #endif
        HListMContains 'TellableFlag x ('Tellable x ': tr) where
      readHListMElem :: HListM ('Tellable x : tr) -> x
    readHListMElem (x :: x
    x :-+: _) = x
    x
    x
      writeHListMElem :: x -> HListM ('Tellable x : tr) -> HListM ('Tellable x : tr)
    writeHListMElem x :: x
    x ts :: HListM ('Tellable x : tr)
    ts = case HListM ('Tellable x : tr)
    ts of (_ :-+: tr :: HListM xr
    tr) -> x
    x x -> HListM xr -> HListM ('Tellable x : xr)
    forall xr (xr :: [CanReadWrite *]).
    xr -> HListM xr -> HListM ('Tellable xr : xr)
    :-+: HListM xr
    tr

    instance HListMContains 'TellableFlag x ts => HListMContains 'TellableFlag x (t ': ts) where
      readHListMElem :: HListM (t : ts) -> x
    readHListMElem (_ :+-: xr :: HListM xr
    xr) = HListM xr -> x
    forall (can :: CanReadWriteFlag) t (cts :: [CanReadWrite *]).
    HListMContains can t cts =>
    HListM cts -> t
    readHListMElem @'TellableFlag HListM xr
    xr
      readHListMElem (_ :-+: xr :: HListM xr
    xr) = HListM xr -> x
    forall (can :: CanReadWriteFlag) t (cts :: [CanReadWrite *]).
    HListMContains can t cts =>
    HListM cts -> t
    readHListMElem @'TellableFlag HListM xr
    xr
      readHListMElem (_ :++: xr :: HListM xr
    xr) = HListM xr -> x
    forall (can :: CanReadWriteFlag) t (cts :: [CanReadWrite *]).
    HListMContains can t cts =>
    HListM cts -> t
    readHListMElem @'TellableFlag HListM xr
    xr
      writeHListMElem :: x -> HListM (t : ts) -> HListM (t : ts)
    writeHListMElem x :: x
    x (t :: x
    t :+-: tr :: HListM xr
    tr) = x
    t x -> HListM xr -> HListM ('Gettable x : xr)
    forall x (x :: [CanReadWrite *]).
    x -> HListM x -> HListM ('Gettable x : x)
    :+-: x -> HListM xr -> HListM xr
    forall (can :: CanReadWriteFlag) t (cts :: [CanReadWrite *]).
    (HListMContains can t cts, CanWriteConstraint can) =>
    t -> HListM cts -> HListM cts
    writeHListMElem @'TellableFlag x
    x HListM xr
    tr
      writeHListMElem x :: x
    x (t :: x
    t :-+: tr :: HListM xr
    tr) = x
    t x -> HListM xr -> HListM ('Tellable x : xr)
    forall xr (xr :: [CanReadWrite *]).
    xr -> HListM xr -> HListM ('Tellable xr : xr)
    :-+: x -> HListM xr -> HListM xr
    forall (can :: CanReadWriteFlag) t (cts :: [CanReadWrite *]).
    (HListMContains can t cts, CanWriteConstraint can) =>
    t -> HListM cts -> HListM cts
    writeHListMElem @'TellableFlag x
    x HListM xr
    tr
      writeHListMElem x :: x
    x (t :: x
    t :++: tr :: HListM xr
    tr) = x
    t x -> HListM xr -> HListM ('Settable x : xr)
    forall x (xr :: [CanReadWrite *]).
    x -> HListM xr -> HListM ('Settable x : xr)
    :++: x -> HListM xr -> HListM xr
    forall (can :: CanReadWriteFlag) t (cts :: [CanReadWrite *]).
    (HListMContains can t cts, CanWriteConstraint can) =>
    t -> HListM cts -> HListM cts
    writeHListMElem @'TellableFlag x
    x HListM xr
    tr

    instance
    #if MIN_VERSION_base(4,8,0)
      {-# OVERLAPPING #-}
    #endif
        HListMContains 'GettableFlag x ('Settable x ': tr)
        => HListMContains 'SettableFlag x ('Settable x ': tr) where
      readHListMElem :: HListM ('Settable x : tr) -> x
    readHListMElem (x :: x
    x :++: _) = x
    x
    x
      writeHListMElem :: x -> HListM ('Settable x : tr) -> HListM ('Settable x : tr)
    writeHListMElem x :: x
    x ts :: HListM ('Settable x : tr)
    ts = case HListM ('Settable x : tr)
    ts of (_ :++: tr :: HListM xr
    tr) -> x
    x x -> HListM xr -> HListM ('Settable x : xr)
    forall x (xr :: [CanReadWrite *]).
    x -> HListM xr -> HListM ('Settable x : xr)
    :++: HListM xr
    tr

    instance HListMContains 'SettableFlag x ts => HListMContains 'SettableFlag x (t ': ts) where
      readHListMElem :: HListM (t : ts) -> x
    readHListMElem (_ :+-: xr :: HListM xr
    xr) = HListM xr -> x
    forall (can :: CanReadWriteFlag) t (cts :: [CanReadWrite *]).
    HListMContains can t cts =>
    HListM cts -> t
    readHListMElem @'SettableFlag HListM xr
    xr
      readHListMElem (_ :-+: xr :: HListM xr
    xr) = HListM xr -> x
    forall (can :: CanReadWriteFlag) t (cts :: [CanReadWrite *]).
    HListMContains can t cts =>
    HListM cts -> t
    readHListMElem @'SettableFlag HListM xr
    xr
      readHListMElem (_ :++: xr :: HListM xr
    xr) = HListM xr -> x
    forall (can :: CanReadWriteFlag) t (cts :: [CanReadWrite *]).
    HListMContains can t cts =>
    HListM cts -> t
    readHListMElem @'SettableFlag HListM xr
    xr
      writeHListMElem :: x -> HListM (t : ts) -> HListM (t : ts)
    writeHListMElem x :: x
    x (t :: x
    t :+-: tr :: HListM xr
    tr) = x
    t x -> HListM xr -> HListM ('Gettable x : xr)
    forall x (x :: [CanReadWrite *]).
    x -> HListM x -> HListM ('Gettable x : x)
    :+-: x -> HListM xr -> HListM xr
    forall (can :: CanReadWriteFlag) t (cts :: [CanReadWrite *]).
    (HListMContains can t cts, CanWriteConstraint can) =>
    t -> HListM cts -> HListM cts
    writeHListMElem @'SettableFlag x
    x HListM xr
    tr
      writeHListMElem x :: x
    x (t :: x
    t :-+: tr :: HListM xr
    tr) = x
    t x -> HListM xr -> HListM ('Tellable x : xr)
    forall xr (xr :: [CanReadWrite *]).
    xr -> HListM xr -> HListM ('Tellable xr : xr)
    :-+: x -> HListM xr -> HListM xr
    forall (can :: CanReadWriteFlag) t (cts :: [CanReadWrite *]).
    (HListMContains can t cts, CanWriteConstraint can) =>
    t -> HListM cts -> HListM cts
    writeHListMElem @'SettableFlag x
    x HListM xr
    tr
      writeHListMElem x :: x
    x (t :: x
    t :++: tr :: HListM xr
    tr) = x
    t x -> HListM xr -> HListM ('Settable x : xr)
    forall x (xr :: [CanReadWrite *]).
    x -> HListM xr -> HListM ('Settable x : xr)
    :++: x -> HListM xr -> HListM xr
    forall (can :: CanReadWriteFlag) t (cts :: [CanReadWrite *]).
    (HListMContains can t cts, CanWriteConstraint can) =>
    t -> HListM cts -> HListM cts
    writeHListMElem @'SettableFlag x
    x HListM xr
    tr

    type family CanWriteConstraint (f :: CanReadWriteFlag) :: Constraint where
      CanWriteConstraint 'TellableFlag = ()
      CanWriteConstraint 'SettableFlag = ()

    data HListM :: [CanReadWrite Type] -> Type where
      HNilM :: HListM '[]
      (:+-:) :: x -> HListM xr -> HListM ('Gettable x ': xr)
      (:++:) :: x -> HListM xr -> HListM ('Settable x ': xr)
      (:-+:) :: x -> HListM xr -> HListM ('Tellable x ': xr)

    instance Semigroup (HListM '[]) where
      _ <> :: HListM '[] -> HListM '[] -> HListM '[]
    <> _ = HListM '[]
    HNilM

    instance Monoid (HListM '[]) where
      mempty :: HListM '[]
    mempty = HListM '[]
    HNilM
      mappend :: HListM '[] -> HListM '[] -> HListM '[]
    mappend = HListM '[] -> HListM '[] -> HListM '[]
    forall a. Semigroup a => a -> a -> a
    (<>)

    instance Eq (HListM '[]) where
      HNilM == :: HListM '[] -> HListM '[] -> Bool
    == HNilM = Bool
    True
      HNilM /= :: HListM '[] -> HListM '[] -> Bool
    /= HNilM = Bool
    False

    instance (Eq x, Eq (HListM xs))
          => Eq (HListM ('Gettable x ': xs))
      where
        x1 :: x
    x1 :+-: xr1 :: HListM xr
    xr1 == :: HListM ('Gettable x : xs) -> HListM ('Gettable x : xs) -> Bool
    == x2 :: x
    x2 :+-: xr2 :: HListM xr
    xr2 = x
    x1x -> x -> Bool
    forall a. Eq a => a -> a -> Bool
    ==x
    x
    x2 Bool -> Bool -> Bool
    && HListM xr
    xr1HListM xr -> HListM xr -> Bool
    forall a. Eq a => a -> a -> Bool
    ==HListM xr
    HListM xr
    xr2
        x1 :: x
    x1 :+-: xr1 :: HListM xr
    xr1 /= :: HListM ('Gettable x : xs) -> HListM ('Gettable x : xs) -> Bool
    /= x2 :: x
    x2 :+-: xr2 :: HListM xr
    xr2 = x
    x1x -> x -> Bool
    forall a. Eq a => a -> a -> Bool
    /=x
    x
    x2 Bool -> Bool -> Bool
    || HListM xr
    xr1HListM xr -> HListM xr -> Bool
    forall a. Eq a => a -> a -> Bool
    /=HListM xr
    HListM xr
    xr2
    instance (Eq x, Eq (HListM xs))
          => Eq (HListM ('Tellable x ': xs))
      where
        x1 :: x
    x1 :-+: xr1 :: HListM xr
    xr1 == :: HListM ('Tellable x : xs) -> HListM ('Tellable x : xs) -> Bool
    == x2 :: x
    x2 :-+: xr2 :: HListM xr
    xr2 = x
    x1x -> x -> Bool
    forall a. Eq a => a -> a -> Bool
    ==x
    x
    x2 Bool -> Bool -> Bool
    && HListM xr
    xr1HListM xr -> HListM xr -> Bool
    forall a. Eq a => a -> a -> Bool
    ==HListM xr
    HListM xr
    xr2
        x1 :: x
    x1 :-+: xr1 :: HListM xr
    xr1 /= :: HListM ('Tellable x : xs) -> HListM ('Tellable x : xs) -> Bool
    /= x2 :: x
    x2 :-+: xr2 :: HListM xr
    xr2 = x
    x1x -> x -> Bool
    forall a. Eq a => a -> a -> Bool
    /=x
    x
    x2 Bool -> Bool -> Bool
    || HListM xr
    xr1HListM xr -> HListM xr -> Bool
    forall a. Eq a => a -> a -> Bool
    /=HListM xr
    HListM xr
    xr2
    instance (Eq x, Eq (HListM xs))
          => Eq (HListM ('Settable x ': xs))
      where
        x1 :: x
    x1 :++: xr1 :: HListM xr
    xr1 == :: HListM ('Settable x : xs) -> HListM ('Settable x : xs) -> Bool
    == x2 :: x
    x2 :++: xr2 :: HListM xr
    xr2 = x
    x1x -> x -> Bool
    forall a. Eq a => a -> a -> Bool
    ==x
    x
    x2 Bool -> Bool -> Bool
    && HListM xr
    xr1HListM xr -> HListM xr -> Bool
    forall a. Eq a => a -> a -> Bool
    ==HListM xr
    HListM xr
    xr2
        x1 :: x
    x1 :++: xr1 :: HListM xr
    xr1 /= :: HListM ('Settable x : xs) -> HListM ('Settable x : xs) -> Bool
    /= x2 :: x
    x2 :++: xr2 :: HListM xr
    xr2 = x
    x1x -> x -> Bool
    forall a. Eq a => a -> a -> Bool
    /=x
    x
    x2 Bool -> Bool -> Bool
    || HListM xr
    xr1HListM xr -> HListM xr -> Bool
    forall a. Eq a => a -> a -> Bool
    /=HListM xr
    HListM xr
    xr2

    type family AppendM (l1 :: [CanReadWrite Type]) (l2 :: [CanReadWrite Type]) :: [CanReadWrite Type] where
      AppendM '[] l2 = l2
      AppendM (car1 ': cdr2) l2 = car1 ': AppendM cdr2 l2

    type family HListMReaders (l :: [Type]) :: [CanReadWrite Type] where
      HListMReaders '[] = '[]
      HListMReaders (t ': tr) = 'Gettable t ': HListMReaders tr

    type family AppendMReaders (l1 :: [Type]) (l2 :: [CanReadWrite Type]) :: [CanReadWrite Type] where
      AppendMReaders '[] l2 = l2
      AppendMReaders (t ': tr) l2 = 'Gettable t ': AppendMReaders tr l2

    class HListMGettableClass ts where
      type HListMGettableOnly ts :: [Type]
      hListMGettableOnly :: HListM ts -> HList.HList (HListMGettableOnly ts)

    instance HListMGettableClass '[] where
      type HListMGettableOnly '[] = '[]
      hListMGettableOnly :: HListM '[] -> HList (HListMGettableOnly '[])
    hListMGettableOnly HNilM = HList '[]
    HList (HListMGettableOnly '[])
    HList.HNil

    instance HListMGettableClass tr => HListMGettableClass ('Gettable t ': tr) where
      type HListMGettableOnly ('Gettable t ': tr) = (t ': HListMGettableOnly tr)
      hListMGettableOnly :: HListM ('Gettable t : tr)
    -> HList (HListMGettableOnly ('Gettable t : tr))
    hListMGettableOnly (t :: x
    t :+-: tr :: HListM xr
    tr) = x
    t x
    -> HList (HListMGettableOnly tr)
    -> HList (x : HListMGettableOnly tr)
    forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
    HList.:+: HListM xr -> HList (HListMGettableOnly xr)
    forall (ts :: [CanReadWrite *]).
    HListMGettableClass ts =>
    HListM ts -> HList (HListMGettableOnly ts)
    hListMGettableOnly HListM xr
    tr
    instance HListMGettableClass tr => HListMGettableClass ('Settable t ': tr) where
      type HListMGettableOnly ('Settable t ': tr) = HListMGettableOnly tr
      hListMGettableOnly :: HListM ('Settable t : tr)
    -> HList (HListMGettableOnly ('Settable t : tr))
    hListMGettableOnly (_ :++: tr :: HListM xr
    tr) = HListM xr -> HList (HListMGettableOnly xr)
    forall (ts :: [CanReadWrite *]).
    HListMGettableClass ts =>
    HListM ts -> HList (HListMGettableOnly ts)
    hListMGettableOnly HListM xr
    tr
    instance HListMGettableClass tr => HListMGettableClass ('Tellable t ': tr) where
      type HListMGettableOnly ('Tellable t ': tr) = HListMGettableOnly tr
      hListMGettableOnly :: HListM ('Tellable t : tr)
    -> HList (HListMGettableOnly ('Tellable t : tr))
    hListMGettableOnly (_ :-+: tr :: HListM xr
    tr) = HListM xr -> HList (HListMGettableOnly xr)
    forall (ts :: [CanReadWrite *]).
    HListMGettableClass ts =>
    HListM ts -> HList (HListMGettableOnly ts)
    hListMGettableOnly HListM xr
    tr