    module Data.Bifunctor.Assoc (
        Assoc (..),
        ) where

    import Control.Applicative    (Const (..))
    import Data.Bifunctor         (Bifunctor (..))
    import Data.Bifunctor.Flip    (Flip (..))
    import Data.Bifunctor.Product (Product (..))
    import Data.Bifunctor.Tannen  (Tannen (..))
    import Data.Tagged            (Tagged (..))

    -- | "Semigroup-y" 'Bifunctor's.
    --
    -- @
    -- 'assoc' . 'unassoc' = 'id'
    -- 'unassoc' . 'assoc' = 'id'
    -- 'assoc' . 'bimap' ('bimap' f g) h = 'bimap' f ('bimap' g h) . 'assoc'
    -- @
    --
    -- This library doesn't provide @Monoidal@ class, with left and right unitors.
    -- Are they useful in practice?
    --
    class Bifunctor p => Assoc p where
        assoc :: p (p a b) c -> p a (p b c)
        unassoc :: p a (p b c) -> p (p a b) c

    instance Assoc (,) where
        assoc :: ((a, b), c) -> (a, (b, c))
    assoc ((a :: a
    a, b :: b
    b), c :: c
    c) = (a
    a, (b
    b, c
    c))
        unassoc :: (a, (b, c)) -> ((a, b), c)
    unassoc (a :: a
    a, (b :: b
    b, c :: c
    c)) = ((a
    a, b
    b), c
    c)

    instance Assoc Either where
        assoc :: Either (Either a b) c -> Either a (Either b c)
    assoc (Left (Left a :: a
    a))  = a -> Either a (Either b c)
    forall a b. a -> Either a b
    Left a
    a
        assoc (Left (Right b :: b
    b)) = Either b c -> Either a (Either b c)
    forall a b. b -> Either a b
    Right (b -> Either b c
    forall a b. a -> Either a b
    Left b
    b)
        assoc (Right c :: c
    c)        = Either b c -> Either a (Either b c)
    forall a b. b -> Either a b
    Right (c -> Either b c
    forall a b. b -> Either a b
    Right c
    c)

        unassoc :: Either a (Either b c) -> Either (Either a b) c
    unassoc (Left a :: a
    a)          = Either a b -> Either (Either a b) c
    forall a b. a -> Either a b
    Left (a -> Either a b
    forall a b. a -> Either a b
    Left a
    a)
        unassoc (Right (Left b :: b
    b))  = Either a b -> Either (Either a b) c
    forall a b. a -> Either a b
    Left (b -> Either a b
    forall a b. b -> Either a b
    Right b
    b)
        unassoc (Right (Right c :: c
    c)) = c -> Either (Either a b) c
    forall a b. b -> Either a b
    Right c
    c

    instance Assoc Const where
        assoc :: Const (Const a b) c -> Const a (Const b c)
    assoc (Const (Const a :: a
    a)) = a -> Const a (Const b c)
    forall k a (b :: k). a -> Const a b
    Const a
    a
        unassoc :: Const a (Const b c) -> Const (Const a b) c
    unassoc (Const a :: a
    a) = Const a b -> Const (Const a b) c
    forall k a (b :: k). a -> Const a b
    Const (a -> Const a b
    forall k a (b :: k). a -> Const a b
    Const a
    a)

    instance Assoc Tagged where
        assoc :: Tagged (Tagged a b) c -> Tagged a (Tagged b c)
    assoc (Tagged a :: c
    a) = Tagged b c -> Tagged a (Tagged b c)
    forall k (s :: k) b. b -> Tagged s b
    Tagged (c -> Tagged b c
    forall k (s :: k) b. b -> Tagged s b
    Tagged c
    a)
        unassoc :: Tagged a (Tagged b c) -> Tagged (Tagged a b) c
    unassoc (Tagged (Tagged a :: c
    a)) = c -> Tagged (Tagged a b) c
    forall k (s :: k) b. b -> Tagged s b
    Tagged c
    a

    instance Assoc p => Assoc (Flip p) where
        assoc :: Flip p (Flip p a b) c -> Flip p a (Flip p b c)
    assoc   = p (Flip p b c) a -> Flip p a (Flip p b c)
    forall k k1 (p :: k -> k1 -> *) (a :: k1) (b :: k).
    p b a -> Flip p a b
    Flip (p (Flip p b c) a -> Flip p a (Flip p b c))
    -> (Flip p (Flip p a b) c -> p (Flip p b c) a)
    -> Flip p (Flip p a b) c
    -> Flip p a (Flip p b c)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (p c b -> Flip p b c) -> p (p c b) a -> p (Flip p b c) a
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first p c b -> Flip p b c
    forall k k1 (p :: k -> k1 -> *) (a :: k1) (b :: k).
    p b a -> Flip p a b
    Flip (p (p c b) a -> p (Flip p b c) a)
    -> (Flip p (Flip p a b) c -> p (p c b) a)
    -> Flip p (Flip p a b) c
    -> p (Flip p b c) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . p c (p b a) -> p (p c b) a
    forall (p :: * -> * -> *) a b c.
    Assoc p =>
    p a (p b c) -> p (p a b) c
    unassoc (p c (p b a) -> p (p c b) a)
    -> (Flip p (Flip p a b) c -> p c (p b a))
    -> Flip p (Flip p a b) c
    -> p (p c b) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Flip p a b -> p b a) -> p c (Flip p a b) -> p c (p b a)
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second Flip p a b -> p b a
    forall k1 k2 (p :: k2 -> k1 -> *) (a :: k1) (b :: k2).
    Flip p a b -> p b a
    runFlip (p c (Flip p a b) -> p c (p b a))
    -> (Flip p (Flip p a b) c -> p c (Flip p a b))
    -> Flip p (Flip p a b) c
    -> p c (p b a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Flip p (Flip p a b) c -> p c (Flip p a b)
    forall k1 k2 (p :: k2 -> k1 -> *) (a :: k1) (b :: k2).
    Flip p a b -> p b a
    runFlip
        unassoc :: Flip p a (Flip p b c) -> Flip p (Flip p a b) c
    unassoc = p c (Flip p a b) -> Flip p (Flip p a b) c
    forall k k1 (p :: k -> k1 -> *) (a :: k1) (b :: k).
    p b a -> Flip p a b
    Flip (p c (Flip p a b) -> Flip p (Flip p a b) c)
    -> (Flip p a (Flip p b c) -> p c (Flip p a b))
    -> Flip p a (Flip p b c)
    -> Flip p (Flip p a b) c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (p b a -> Flip p a b) -> p c (p b a) -> p c (Flip p a b)
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second p b a -> Flip p a b
    forall k k1 (p :: k -> k1 -> *) (a :: k1) (b :: k).
    p b a -> Flip p a b
    Flip (p c (p b a) -> p c (Flip p a b))
    -> (Flip p a (Flip p b c) -> p c (p b a))
    -> Flip p a (Flip p b c)
    -> p c (Flip p a b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . p (p c b) a -> p c (p b a)
    forall (p :: * -> * -> *) a b c.
    Assoc p =>
    p (p a b) c -> p a (p b c)
    assoc (p (p c b) a -> p c (p b a))
    -> (Flip p a (Flip p b c) -> p (p c b) a)
    -> Flip p a (Flip p b c)
    -> p c (p b a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Flip p b c -> p c b) -> p (Flip p b c) a -> p (p c b) a
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first Flip p b c -> p c b
    forall k1 k2 (p :: k2 -> k1 -> *) (a :: k1) (b :: k2).
    Flip p a b -> p b a
    runFlip (p (Flip p b c) a -> p (p c b) a)
    -> (Flip p a (Flip p b c) -> p (Flip p b c) a)
    -> Flip p a (Flip p b c)
    -> p (p c b) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Flip p a (Flip p b c) -> p (Flip p b c) a
    forall k1 k2 (p :: k2 -> k1 -> *) (a :: k1) (b :: k2).
    Flip p a b -> p b a
    runFlip

    -- $setup
    --
    -- TODO: make proper test-suite
    --
    -- >>> import Data.Proxy
    -- >>> import Test.QuickCheck
    -- >>> import Test.QuickCheck.Instances
    -- >>> import Data.Functor.Classes
    --
    -- >>> :{
    --     let assocUnassocLaw :: (Assoc p, Eq2 p) => Proxy p -> p Bool (p Int Char) -> Bool
    --         assocUnassocLaw _ x = liftEq2 (==) eq2 (assoc (unassoc x)) x
    --     :}
    --
    -- >>> quickCheck $ assocUnassocLaw (Proxy :: Proxy (,))
    -- +++ OK, passed 100 tests.
    --
    -- >>> quickCheck $ assocUnassocLaw (Proxy :: Proxy Either)
    -- +++ OK, passed 100 tests.
    --
    -- >>> quickCheck $ assocUnassocLaw (Proxy :: Proxy Tagged)
    -- +++ OK, passed 100 tests.
    --
    -- >>> quickCheck $ assocUnassocLaw (Proxy :: Proxy Const)
    -- +++ OK, passed 100 tests.
    --
    -- >>> :{
    --     let unassocAssocLaw :: (Assoc p, Eq2 p) => Proxy p -> p (p Int Char) Bool -> Bool
    --         unassocAssocLaw _ x = liftEq2 eq2 (==) (unassoc (assoc x)) x
    --     :}
    --
    -- >>> quickCheck $ unassocAssocLaw (Proxy :: Proxy (,))
    -- +++ OK, passed 100 tests.
    --
    -- >>> quickCheck $ unassocAssocLaw (Proxy :: Proxy Either)
    -- +++ OK, passed 100 tests.
    --
    -- >>> quickCheck $ unassocAssocLaw (Proxy :: Proxy Tagged)
    -- +++ OK, passed 100 tests.
    --
    -- >>> quickCheck $ unassocAssocLaw (Proxy :: Proxy Const)
    -- +++ OK, passed 100 tests.
    --
    -- >>> :{
    --     let bimapLaw :: (Assoc p, Eq2 p) => Proxy p
    --                  -> Fun Int Char -> Fun Char Bool -> Fun Bool Int
    --                  -> p (p Int Char) Bool
    --                  -> Bool
    --         bimapLaw _ (Fun _ f) (Fun _ g) (Fun _ h) x = liftEq2 (==) eq2
    --             (assoc . bimap (bimap f g) h $ x)
    --             (bimap f (bimap g h) . assoc $ x)
    --     :}
    --
    -- >>> quickCheck $ bimapLaw (Proxy :: Proxy (,))
    -- +++ OK, passed 100 tests.
    --
    -- >>> quickCheck $ bimapLaw (Proxy :: Proxy Either)
    -- +++ OK, passed 100 tests.
    --
    -- >>> quickCheck $ bimapLaw (Proxy :: Proxy Tagged)
    -- +++ OK, passed 100 tests.
    --
    -- >>> quickCheck $ bimapLaw (Proxy :: Proxy Const)
    -- +++ OK, passed 100 tests.