Costar runtime error

Main.purs

module Main where

import Prelude
import Data.Lens (Iso, _1, _2, iso)
import Data.Profunctor (class Profunctor)
import Data.Profunctor.Costrong (class Costrong, unfirst, unsecond)
import Data.Profunctor.Strong (class Strong, first)
import Data.Tuple (Tuple(..), fst, snd)
import Effect (Effect)
import Effect.Console (log)
import Data.Identity (Identity(..))
import Data.Newtype (class Newtype, unwrap)
import Data.Profunctor.Costar (Costar(..))

newtype Forget' r a b
  = Forget' (a -> r)

derive instance newtypeForget' :: Newtype (Forget' r a b) _

instance profunctorForget' :: Profunctor (Forget' r) where
  dimap f _ (Forget' z) = Forget' (z <<< f)

instance strongForget' :: Strong (Forget' r) where
  first (Forget' z) = Forget' (z <<< fst)
  second (Forget' z) = Forget' (z <<< snd)

instance costrongForget' :: Costrong (Forget' r) where
  unfirst (Forget' z) = Forget' $ ((unwrap <<< unfirst <<< Costar) (\(Identity t@(Tuple x y)) -> Tuple (z t) y)) <<< Identity
  unsecond (Forget' z) = Forget' $ ((unwrap <<< unsecond <<< Costar) (\(Identity t@(Tuple x y)) -> Tuple x (z t))) <<< Identity

-- adds pathway for c to flow through in snd
firstAlley :: forall r s t a b c. (Forget' r a b -> Forget' r s t) -> Forget' r (Tuple a c) (Tuple b c) -> Forget' r (Tuple s c) (Tuple t c)
firstAlley o = first <<< o <<< unfirst

-- adds pathway for c to flow through in fst
secondAlley :: forall r s t a b c. (Forget' r a b -> Forget' r s t) -> Forget' r (Tuple a c) (Tuple b c) -> Forget' r (Tuple s c) (Tuple t c)
secondAlley o = first <<< o <<< unfirst

-- _1 with and arbitrary `c` flowing through snd
_1' :: ∀ r a b c d. Forget' r (Tuple a c) (Tuple b c) → Forget' r (Tuple (Tuple a d) c) (Tuple (Tuple b d) c)
_1' = firstAlley _1

-- _2 with and arbitrary `c` flowing through snd
_2' :: ∀ r a b c d. Forget' r (Tuple a c) (Tuple b c) → Forget' r (Tuple (Tuple d a) c) (Tuple (Tuple d b) c)
_2' = firstAlley _2

-- duplicates a value, pegging it as snd in a tuple
pegAtSecond :: forall a b. Iso a b (Tuple a a) (Tuple b a)
pegAtSecond = iso (\i -> Tuple i i) (\(Tuple f s) -> f)

main :: Effect Unit
main =
  log
    ( show
        ( ( unwrap
              ( (_2 <<< pegAtSecond <<< _2' <<< _2') -- lens
                  (Forget' fst) -- profunctor for fold
              )
          )
            (Tuple 0 (Tuple 1 (Tuple 2 3))) -- data structure
        )
    )