Quasar https://github.com/pasberth/Quasar cf. https://gist.github.com/fumieval/4114850

Universe.hs

{-# LANGUAGE TypeOperators, MultiParamTypeClasses, FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts, TypeFamilies, UndecidableInstances #-}
import Control.Comonad

data BigCrunch = BigCrunch deriving (Show)
data f :> g = f :> g deriving (Show)
infixr :>

class Universal c a where
  runUniverse :: c -> a

instance (Universal d (b -> c), a ~ a') => Universal ((a -> b) :> d) (a' -> c) where
  runUniverse (f :> g) = runUniverse g . f

instance (a ~ a') => Universal BigCrunch (a -> a') where
  runUniverse BigCrunch = id

newtype Space a b = Space (b :> a)
instance Functor (Space a) where
  fmap f (Space (b :> a)) = Space $ f b :> a

instance Comonad (Space a) where
  extract (Space (f :> _)) = f

data Z = Z deriving (Show)
data Succ a = Succ a deriving (Show)

class Timemachine n c a where
  backTo :: c -> n -> a

instance (c ~ c') => Timemachine Z c c' where
  backTo u _ = u

instance (e ~ e', Timemachine n d e) => Timemachine (Succ n) (a :> d) e' where
  backTo (_ :> f) (Succ n) = backTo f n

instance Timemachine n BigCrunch a where
  backTo BigCrunch _ = error "backTo BigCrunch!"

data Universe a = a :-> (Universe a) | End BigCrunch deriving (Show)
type Arrowverse a = Universe (a -> a)
infixr :->

bigCrunch :: Universe a
bigCrunch = End BigCrunch

instance Universal (Arrowverse a) (a -> a) where
  runUniverse (f :-> a) = runUniverse a . f
  runUniverse (End BigCrunch) = id

instance Functor Universe where
  fmap f (k :-> a) = (f k) :-> (fmap f a)
  fmap f (End BigCrunch) = End BigCrunch

instance Comonad Universe where
  extract (f :-> _) = f
  extract (End BigCrunch) = undefined

ex :: Arrowverse Int
ex = (*3) :-> (+2) :-> bigCrunch

ex2 :: Universe Int
ex2 = 3 :-> 4 :-> 2 :-> bigCrunch

ex3 = (*3) :> (subtract 7) :> show :> reverse :> head :> BigCrunch

main = do
  print $ runUniverse (ex3 `backTo` Succ Z) 42
  -- #=> '5'