{- |
Various ways of shuffling input and output components. Function types are mostly autogenerated.
-}
module Control.Arrow.Mix.Utilities where
import Control.Arrow
swap :: (t1, t) -> (t, t1)
swap ~(a, b) = (b, a)
twist :: ((t1, t), t2) -> ((t1, t2), t)
twist ~((a, b), c) = ((a, c), b)
assocLtoR :: ((t, t1), t2) -> (t, (t1, t2))
assocLtoR ~((a, b), c) = (a, (b, c))
assocRtoL :: (t1, (t2, t)) -> ((t1, t2), t)
assocRtoL ~(a, (b, c)) = ((a, b), c)
arrTwist
  :: Arrow a =>
     a ((t1, t2), t) ((t4, t3), t5) -> a ((t1, t), t2) ((t4, t5), t3)
arrTwist a = twist ^>> a >>^ twist
arrAssocRtoL
  :: Arrow a =>
     a (t, (t1, t2)) (t4, (t5, t3)) -> a ((t, t1), t2) ((t4, t5), t3)
arrAssocRtoL a = assocLtoR ^>> a >>^ assocRtoL
arrAssocLtoR
  :: Arrow a =>
     a ((t1, t2), t) ((t3, t4), t5) -> a (t1, (t2, t)) (t3, (t4, t5))
arrAssocLtoR a = assocRtoL ^>> a >>^ assocLtoR
arrCancelUnitFst :: Arrow a => a (b, ()) (d, ()) -> a b d
arrCancelUnitFst a = (,()) ^>> a >>^ fst
arrCancelUnitSnd :: Arrow a => a ((), b) (d, ()) -> a b d
arrCancelUnitSnd a = ((),) ^>> a >>^ fst