{- |
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)
arrSwap :: Arrow a => a (t, t1) (t2, t3) -> a (t1, t) (t3, t2)
arrSwap a = swap ^>> a >>^ swap
arrTwist
  :: Arrow a =>
     a ((t1, t2), t) ((t4, t3), t5) -> a ((t1, t), t2) ((t4, t5), t3)
arrTwist a = twist ^>> a >>^ twist
pack :: Either (a, t) (b, t) -> (Either a b, t)
pack (Left (output, o)) = (Left output, o)
pack (Right (z, o)) = (Right z, o)
unpack :: (Either t t1, t2) -> Either (t, t2) (t1, t2)
unpack (Left input, i) = Left (input, i)
unpack (Right z, i) = Right (z, i)
arrAssoc
  :: Arrow a =>
     a ((t1, t2), t) ((t3, t4), t5) -> a (t1, (t2, t)) (t3, (t4, t5))
arrAssoc a = assocRtoL ^>> a >>^ assocLtoR
arrCancelUnit :: Arrow a => a ((), b) ((), d) -> a b d
arrCancelUnit a = ((),) ^>> a >>^ snd
arrUnpack
  :: Arrow a =>
     a (Either (t, t2) (t1, t2)) (Either (a1, t3) (b, t3))
     -> a (Either t t1, t2) (Either a1 b, t3)
arrUnpack a = unpack ^>> a >>^ pack
(->>) :: Arrow a => a (input, i1) (middle, o1) -> a (middle, i2) (output, o2) -> a ((input, i1), i2) ((output, o1), o2)
a1 ->> a2 = first a1 >>> arrTwist (first a2)