module Data.Triunfoldable
(
Triunfoldable(..)
, triunfold_
, triunfoldBF
, triunfoldBF_
, triunfoldr
, fromLists
, randomDefault
, arbitraryDefault
)
where
import Control.Applicative
import Data.Unfolder
import Data.Functor.Constant
import Control.Monad.Trans.State
import qualified System.Random as R
import Test.QuickCheck.Arbitrary (Arbitrary(..))
import Test.QuickCheck.Gen (Gen(..))
import Data.Maybe
class Triunfoldable t where
triunfold :: Unfolder f => f a -> f b -> f c -> f (t a b c)
triunfold_ :: (Triunfoldable t, Unfolder f) => f (t () () ())
triunfold_ = triunfold (pure ()) (pure ()) (pure ())
triunfoldBF :: (Triunfoldable t, Unfolder f) => f a -> f b -> f c -> f (t a b c)
triunfoldBF = ala3 bfs triunfold
triunfoldBF_ :: (Triunfoldable t, Unfolder f) => f (t () () ())
triunfoldBF_ = bfs triunfold_
triunfoldr :: Triunfoldable t => (d -> Maybe (a, d)) -> (d -> Maybe (b, d)) -> (d -> Maybe (c, d)) -> d -> Maybe (t a b c)
triunfoldr fa fb fc z = terminate . flip runStateT z $ triunfoldBF (StateT $ maybeToList . fa) (StateT $ maybeToList . fb) (StateT $ maybeToList . fc)
where
terminate [] = Nothing
terminate ((t, d):ts) = if (isNothing (fa d) && isNothing (fb d) && isNothing (fc d)) then Just t else terminate ts
fromLists :: Triunfoldable t => [a] -> [b] -> [c] -> Maybe (t a b c)
fromLists = curry3 $ triunfoldr unconsA unconsB unconsC
where
unconsA ([], _, _) = Nothing
unconsA (a:as, bs, cs) = Just (a, (as, bs, cs))
unconsB (_, [], _) = Nothing
unconsB (as, b:bs, cs) = Just (b, (as, bs, cs))
unconsC (_, _, []) = Nothing
unconsC (as, bs, c:cs) = Just (c, (as, bs, cs))
randomDefault :: (R.Random a, R.Random b, R.Random c, R.RandomGen g, Triunfoldable t) => g -> (t a b c, g)
randomDefault = runState . getRandom $ triunfold (Random . state $ R.random) (Random . state $ R.random) (Random . state $ R.random)
arbitraryDefault :: (Arbitrary a, Arbitrary b, Arbitrary c, Triunfoldable t) => Gen (t a b c)
arbitraryDefault = MkGen $ \r n -> let Arb _ f = triunfold arbUnit arbUnit arbUnit in
fromMaybe (error "Failed to generate a value.") (f r (n + 1))
curry3 :: ((a,b,c) -> d) -> a -> b -> c -> d
curry3 f a b c = f (a,b,c)
instance Triunfoldable (,,) where
triunfold fa fb fc = choose
[ (,,) <$> fa <*> fb <*> fc ]