```module Control.Arrow.Mix.Category (Along, (:~>), (:~~>), AlMonad(..), (~>>=), AlFunctor(..), OhNo, (:\$~)(..)) where
import Prelude hiding (id, (.))
import Control.Arrow
import Control.Category
import Control.Arrow.Mix.Utilities
-- | Arrow morphism
type f :~> g = forall i o. f i o -> g i o
infixr 0 :~>
-- | Refined arrow morphism
type f :~~> g = forall i o. (i -> o) -> f i o -> g i o
infixr 0 :~~>
-- | Sometimes we need to refine our morphism a bit; therefore, we use @Along f i o@ instead of just @f@.
type Along f input output i o = f (input, i) (output, o)
-- | Something like a monad - but for arrows
class AlMonad m where
alRet :: Arrow b => b :~> m b
alLift :: (Arrow b, Arrow c) => (Along b i1 o1 :~~> Along (m c) i2 o2) -> (m b i1 o1 -> m c i2 o2)
-- | Most of time we don't need refined morphisms. That's why we would want a simpler combinator.
(~>>=) :: (AlMonad m, Arrow b, Arrow c) => m b i1 o1 -> (Along b i1 o1 :~> Along (m c) i2 o2) -> m c i2 o2
m ~>>= h = alLift (const h) m
infixl 1 ~>>=
-- | Something like a functor - again, for arrows
class AlFunctor f where
alMap :: (Arrow b, Arrow c) => (Along b i1 o1 :~> Along c i2 o2) -> (f b i1 o1 -> f c i2 o2)
-- | Just a trick to avoid specifying rank explicitly
type OhNo a b = b
-- | Declarations like @instance Monad m => Functor m@ don't work well in Haskell. That's why we need a newtype.
newtype (f :\$~ a) input output = Apply {runApply :: a input output `OhNo` f a input output} deriving AlMonad
infixl 0 :\$~
instance AlMonad m => AlFunctor ((:\$~) m) where
alMap h m = m ~>>= \b -> alRet \$ h b
instance (AlMonad m, Arrow a) => Category (m :\$~ a) where
id = alRet id
m2 . m1 = m1 ~>>= \a1 -> m2 ~>>= \a2 -> alRet \$ a1 ->> a2
instance (AlMonad m, Arrow a) => Arrow (m :\$~ a) where
arr = alRet . arr
first m = m ~>>= \a -> alRet \$ arrTwist \$ first a
instance (AlMonad m, ArrowLoop a) => ArrowLoop (m :\$~ a) where
loop m = m ~>>= \a -> alRet \$ loop \$ arrTwist a
instance (AlMonad m, ArrowChoice a) => ArrowChoice (m :\$~ a) where
left = alLift \$ \t a -> alRet \$ arrUnpack \$ a +++ arr (second t)
```