module Hedgehog.Classes.Common.ApTrans
  ( apTrans
  , toSpecialApplicative
  ) where

import Data.Tuple (swap)
import Data.Functor.Compose
import qualified Data.Set as S
import qualified Control.Monad.Trans.Writer.Lazy as WL

import Hedgehog.Classes.Common.Func

-- Reverse the list and accumulate the writers. We
-- cannot use Sum or Product or else it won't actually
-- be a valid applicative transformation.
apTrans ::
     Compose Triple (WL.Writer (S.Set Integer)) a
  -> Compose (WL.Writer (S.Set Integer)) Triple a
apTrans :: Compose Triple (Writer (Set Integer)) a
-> Compose (Writer (Set Integer)) Triple a
apTrans (Compose Triple (Writer (Set Integer) a)
xs) = WriterT (Set Integer) Identity (Triple a)
-> Compose (Writer (Set Integer)) Triple a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Triple (Writer (Set Integer) a)
-> WriterT (Set Integer) Identity (Triple a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (Triple (Writer (Set Integer) a) -> Triple (Writer (Set Integer) a)
forall a. Triple a -> Triple a
reverseTriple Triple (Writer (Set Integer) a)
xs))

toSpecialApplicative ::
     Compose Triple ((,) (S.Set Integer)) Integer
  -> Compose Triple (WL.Writer (S.Set Integer)) Integer
toSpecialApplicative :: Compose Triple ((,) (Set Integer)) Integer
-> Compose Triple (Writer (Set Integer)) Integer
toSpecialApplicative (Compose (Triple (Set Integer, Integer)
a (Set Integer, Integer)
b (Set Integer, Integer)
c)) =
  Triple (WriterT (Set Integer) Identity Integer)
-> Compose Triple (Writer (Set Integer)) Integer
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (WriterT (Set Integer) Identity Integer
-> WriterT (Set Integer) Identity Integer
-> WriterT (Set Integer) Identity Integer
-> Triple (WriterT (Set Integer) Identity Integer)
forall a. a -> a -> a -> Triple a
Triple ((Integer, Set Integer) -> WriterT (Set Integer) Identity Integer
forall (m :: * -> *) a w. Monad m => (a, w) -> WriterT w m a
WL.writer ((Set Integer, Integer) -> (Integer, Set Integer)
forall a b. (a, b) -> (b, a)
swap (Set Integer, Integer)
a)) ((Integer, Set Integer) -> WriterT (Set Integer) Identity Integer
forall (m :: * -> *) a w. Monad m => (a, w) -> WriterT w m a
WL.writer ((Set Integer, Integer) -> (Integer, Set Integer)
forall a b. (a, b) -> (b, a)
swap (Set Integer, Integer)
b)) ((Integer, Set Integer) -> WriterT (Set Integer) Identity Integer
forall (m :: * -> *) a w. Monad m => (a, w) -> WriterT w m a
WL.writer ((Set Integer, Integer) -> (Integer, Set Integer)
forall a b. (a, b) -> (b, a)
swap (Set Integer, Integer)
c)))