-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Unfoldable
-- Copyright   :  (c) Sjoerd Visscher 2014
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  sjoerd@w3future.com
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Class of data structures that can be unfolded.
-----------------------------------------------------------------------------
{-# LANGUAGE CPP, Safe, TupleSections #-}
#ifdef GENERICS
{-# LANGUAGE TypeOperators, DefaultSignatures, FlexibleContexts, TypeApplications #-}
#endif
module Data.Unfoldable
  (

  -- * Unfoldable
    Unfoldable(..)
  , unfold_
  , unfoldBF
  , unfoldBF_

  -- ** Specific unfolds
  , unfoldr
  , fromList
  , leftMost
  , rightMost
  , allDepthFirst
  , allToDepth
  , allBreadthFirst
  , randomDefault
  , arbitraryDefault

  )
  where

import Control.Applicative
import Data.Unfolder
import Data.Functor.Compose
import Data.Functor.Constant
import Data.Functor.Identity
import Data.Functor.Product
import Data.Functor.Reverse
import Data.Functor.Sum
import Control.Monad.Trans.State
import qualified System.Random as R
import Test.QuickCheck (Arbitrary(..), Gen, sized, resize)
import Data.Maybe
import qualified Data.Sequence as S
import qualified Data.Tree as T

#ifdef GENERICS
import GHC.Generics
import Generics.OneLiner
#endif

-- | Data structures that can be unfolded.
--
-- For example, given a data type
--
-- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)
--
-- a suitable instance would be
--
-- > instance Unfoldable Tree where
-- >   unfold fa = choose
-- >     [ pure Empty
-- >     , Leaf <$> fa
-- >     , Node <$> unfold fa <*> fa <*> unfold fa
-- >     ]
--
-- i.e. it follows closely the instance for 'Traversable', but instead of matching on an input value,
-- we 'choose' from a list of all cases.
--
-- Instead of manually writing the `Unfoldable` instance, you can add a @deriving@ `Generic1`
-- to your datatype and declare an `Unfoldable` instance without giving a definition for `unfold`.
--
-- For example the previous example can be simplified to just:
--
-- > {-# LANGUAGE DeriveGeneric #-}
-- >
-- > import GHC.Generics
-- >
-- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a) deriving Generic1
-- >
-- > instance Unfoldable Tree
class Unfoldable t where
  -- | Given a way to generate elements, return a way to generate structures containing those elements.
  unfold :: Unfolder f => f a -> f (t a)

#ifdef GENERICS
  default unfold :: (ADT1 t, Constraints1 t Unfoldable, Unfolder f) => f a -> f (t a)
  unfold = [f (t a)] -> f (t a)
forall (f :: * -> *) a. Unfolder f => [f a] -> f a
choose ([f (t a)] -> f (t a)) -> (f a -> [f (t a)]) -> f a -> f (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose [] f (t a) -> [f (t a)]
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose [] f (t a) -> [f (t a)])
-> (f a -> Compose [] f (t a)) -> f a -> [f (t a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b (s :: * -> *).
 Unfoldable s =>
 Compose [] f b -> Compose [] f (s b))
-> Compose [] f a -> Compose [] f (t a)
forall (c :: (* -> *) -> Constraint) (t :: * -> *) (f :: * -> *) a.
(ADT1 t, Constraints1 t c, Alternative f) =>
(forall b (s :: * -> *). c s => f b -> f (s b)) -> f a -> f (t a)
createA1 @Unfoldable ([f (s b)] -> Compose [] f (s b)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ([f (s b)] -> Compose [] f (s b))
-> (Compose [] f b -> [f (s b)])
-> Compose [] f b
-> Compose [] f (s b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (s b) -> [f (s b)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f (s b) -> [f (s b)])
-> (Compose [] f b -> f (s b)) -> Compose [] f b -> [f (s b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f b -> f (s b)
forall (t :: * -> *) (f :: * -> *) a.
(Unfoldable t, Unfolder f) =>
f a -> f (t a)
unfold (f b -> f (s b))
-> (Compose [] f b -> f b) -> Compose [] f b -> f (s b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [f b] -> f b
forall (f :: * -> *) a. Alternative f => [f a] -> f a
asum' ([f b] -> f b)
-> (Compose [] f b -> [f b]) -> Compose [] f b -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose [] f b -> [f b]
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) (Compose [] f a -> Compose [] f (t a))
-> (f a -> Compose [] f a) -> f a -> Compose [] f (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [f a] -> Compose [] f a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ([f a] -> Compose [] f a)
-> (f a -> [f a]) -> f a -> Compose [] f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [f a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    where
      asum' :: [f a] -> f a
asum' [] = f a
forall (f :: * -> *) a. Alternative f => f a
empty
      asum' [f a
a] = f a
a
      asum' (f a
a:[f a]
as) = f a
a f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [f a] -> f a
asum' [f a]
as
  {-# INLINE unfold #-}
#endif

-- | Unfold the structure, always using @()@ as elements.
unfold_ :: (Unfoldable t, Unfolder f) => f (t ())
unfold_ :: f (t ())
unfold_ = f () -> f (t ())
forall (t :: * -> *) (f :: * -> *) a.
(Unfoldable t, Unfolder f) =>
f a -> f (t a)
unfold (() -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Breadth-first unfold, which orders the result by the number of 'choose' calls.
unfoldBF :: (Unfoldable t, Unfolder f) => f a -> f (t a)
unfoldBF :: f a -> f (t a)
unfoldBF = (BFS f (t a) -> f (t a))
-> (BFS f a -> BFS f (t a)) -> f a -> f (t a)
forall (t :: (* -> *) -> * -> *) (f :: * -> *) b a.
(UnfolderTransformer t, Unfolder f) =>
(t f b -> f b) -> (t f a -> t f b) -> f a -> f b
ala BFS f (t a) -> f (t a)
forall (f :: * -> *) x. Unfolder f => BFS f x -> f x
bfs BFS f a -> BFS f (t a)
forall (t :: * -> *) (f :: * -> *) a.
(Unfoldable t, Unfolder f) =>
f a -> f (t a)
unfold

-- | Unfold the structure breadth-first, always using @()@ as elements.
unfoldBF_ :: (Unfoldable t, Unfolder f) => f (t ())
unfoldBF_ :: f (t ())
unfoldBF_ = BFS f (t ()) -> f (t ())
forall (f :: * -> *) x. Unfolder f => BFS f x -> f x
bfs BFS f (t ())
forall (t :: * -> *) (f :: * -> *).
(Unfoldable t, Unfolder f) =>
f (t ())
unfold_

-- | @unfoldr@ builds a data structure from a seed value. It can be specified as:
--
-- > unfoldr f z == fromList (Data.List.unfoldr f z)
unfoldr :: Unfoldable t => (b -> Maybe (a, b)) -> b -> Maybe (t a)
unfoldr :: (b -> Maybe (a, b)) -> b -> Maybe (t a)
unfoldr b -> Maybe (a, b)
f b
z = [(t a, b)] -> Maybe (t a)
forall a. [(a, b)] -> Maybe a
terminate ([(t a, b)] -> Maybe (t a))
-> ((b -> [(a, b)]) -> [(t a, b)])
-> (b -> [(a, b)])
-> Maybe (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT b [] (t a) -> b -> [(t a, b)])
-> b -> StateT b [] (t a) -> [(t a, b)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT b [] (t a) -> b -> [(t a, b)]
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT b
z (StateT b [] (t a) -> [(t a, b)])
-> ((b -> [(a, b)]) -> StateT b [] (t a))
-> (b -> [(a, b)])
-> [(t a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT b [] a -> StateT b [] (t a)
forall (t :: * -> *) (f :: * -> *) a.
(Unfoldable t, Unfolder f) =>
f a -> f (t a)
unfoldBF (StateT b [] a -> StateT b [] (t a))
-> ((b -> [(a, b)]) -> StateT b [] a)
-> (b -> [(a, b)])
-> StateT b [] (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> [(a, b)]) -> StateT b [] a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((b -> [(a, b)]) -> Maybe (t a)) -> (b -> [(a, b)]) -> Maybe (t a)
forall a b. (a -> b) -> a -> b
$ Maybe (a, b) -> [(a, b)]
forall a. Maybe a -> [a]
maybeToList (Maybe (a, b) -> [(a, b)]) -> (b -> Maybe (a, b)) -> b -> [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe (a, b)
f
  where
    terminate :: [(a, b)] -> Maybe a
terminate [] = Maybe a
forall a. Maybe a
Nothing
    terminate ((a
t, b
b):[(a, b)]
ts) = if Maybe (a, b) -> Bool
forall a. Maybe a -> Bool
isNothing (b -> Maybe (a, b)
f b
b) then a -> Maybe a
forall a. a -> Maybe a
Just a
t else [(a, b)] -> Maybe a
terminate [(a, b)]
ts

-- | Create a data structure using the list as input.
-- This can fail because there might not be a data structure with the same number
-- of element positions as the number of elements in the list.
fromList :: Unfoldable t => [a] -> Maybe (t a)
fromList :: [a] -> Maybe (t a)
fromList = ([a] -> Maybe (a, [a])) -> [a] -> Maybe (t a)
forall (t :: * -> *) b a.
Unfoldable t =>
(b -> Maybe (a, b)) -> b -> Maybe (t a)
unfoldr [a] -> Maybe (a, [a])
forall a. [a] -> Maybe (a, [a])
uncons
  where
    uncons :: [a] -> Maybe (a, [a])
uncons [] = Maybe (a, [a])
forall a. Maybe a
Nothing
    uncons (a
a:[a]
as) = (a, [a]) -> Maybe (a, [a])
forall a. a -> Maybe a
Just (a
a, [a]
as)

-- | Always choose the first constructor.
leftMost :: Unfoldable t => Maybe (t ())
leftMost :: Maybe (t ())
leftMost = Maybe (t ())
forall (t :: * -> *) (f :: * -> *).
(Unfoldable t, Unfolder f) =>
f (t ())
unfold_

-- | Always choose the last constructor.
rightMost :: Unfoldable t => Maybe (t ())
rightMost :: Maybe (t ())
rightMost = DualA Maybe (t ()) -> Maybe (t ())
forall (f :: * -> *) a. DualA f a -> f a
getDualA DualA Maybe (t ())
forall (t :: * -> *) (f :: * -> *).
(Unfoldable t, Unfolder f) =>
f (t ())
unfold_

-- | Generate all the values depth-first.
allDepthFirst :: Unfoldable t => [t ()]
allDepthFirst :: [t ()]
allDepthFirst = [t ()]
forall (t :: * -> *) (f :: * -> *).
(Unfoldable t, Unfolder f) =>
f (t ())
unfold_

-- | Generate all the values upto a given depth, depth-first.
allToDepth :: Unfoldable t => Int -> [t ()]
allToDepth :: Int -> [t ()]
allToDepth Int
d = Int -> WithRec [] (t ()) -> [t ()]
forall (f :: * -> *) a. Unfolder f => Int -> WithRec f a -> f a
limitDepth Int
d WithRec [] (t ())
forall (t :: * -> *) (f :: * -> *).
(Unfoldable t, Unfolder f) =>
f (t ())
unfold_

-- | Generate all the values breadth-first.
allBreadthFirst :: Unfoldable t => [t ()]
allBreadthFirst :: [t ()]
allBreadthFirst = [t ()]
forall (t :: * -> *) (f :: * -> *).
(Unfoldable t, Unfolder f) =>
f (t ())
unfoldBF_

-- | Generate a random value, can be used as default instance for 'R.Random'.
randomDefault :: (R.Random a, R.RandomGen g, Unfoldable t) => g -> (t a, g)
randomDefault :: g -> (t a, g)
randomDefault = State g (t a) -> g -> (t a, g)
forall s a. State s a -> s -> (a, s)
runState (State g (t a) -> g -> (t a, g))
-> ((g -> (a, g)) -> State g (t a))
-> (g -> (a, g))
-> g
-> (t a, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Random g Identity (t a) -> State g (t a)
forall g (m :: * -> *) a. Random g m a -> StateT g m a
getRandom (Random g Identity (t a) -> State g (t a))
-> ((g -> (a, g)) -> Random g Identity (t a))
-> (g -> (a, g))
-> State g (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Random g Identity a -> Random g Identity (t a)
forall (t :: * -> *) (f :: * -> *) a.
(Unfoldable t, Unfolder f) =>
f a -> f (t a)
unfold (Random g Identity a -> Random g Identity (t a))
-> ((g -> (a, g)) -> Random g Identity a)
-> (g -> (a, g))
-> Random g Identity (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT g Identity a -> Random g Identity a
forall g (m :: * -> *) a. StateT g m a -> Random g m a
Random (StateT g Identity a -> Random g Identity a)
-> ((g -> (a, g)) -> StateT g Identity a)
-> (g -> (a, g))
-> Random g Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g -> (a, g)) -> StateT g Identity a
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((g -> (a, g)) -> g -> (t a, g)) -> (g -> (a, g)) -> g -> (t a, g)
forall a b. (a -> b) -> a -> b
$ g -> (a, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
R.random

-- | Provides a QuickCheck generator, can be used as default instance for 'Arbitrary'.
arbitraryDefault :: (Arbitrary a, Unfoldable t) => Gen (t a)
arbitraryDefault :: Gen (t a)
arbitraryDefault = let Arb Int
_ Int
_ Gen (Maybe (t a))
gen = Arb a -> Arb (t a)
forall (t :: * -> *) (f :: * -> *) a.
(Unfoldable t, Unfolder f) =>
f a -> f (t a)
unfold Arb a
forall a. Arbitrary a => Arb a
arbUnit in
  t a -> Maybe (t a) -> t a
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> t a
forall a. HasCallStack => [Char] -> a
error [Char]
"Failed to generate a value.") (Maybe (t a) -> t a) -> Gen (Maybe (t a)) -> Gen (t a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe (t a))
gen

instance Unfoldable [] where
  unfold :: f a -> f [a]
unfold f a
fa = f [a]
go where
    go :: f [a]
go = [f [a]] -> f [a]
forall (f :: * -> *) a. Unfolder f => [f a] -> f a
choose
      [ [a] -> f [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      , (:) (a -> [a] -> [a]) -> f a -> f ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa f ([a] -> [a]) -> f [a] -> f [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f [a]
go ]

instance Unfoldable Maybe where
  unfold :: f a -> f (Maybe a)
unfold f a
fa = [f (Maybe a)] -> f (Maybe a)
forall (f :: * -> *) a. Unfolder f => [f a] -> f a
choose
    [ Maybe a -> f (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    , a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> f a -> f (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa
    ]

instance (Bounded a, Enum a) => Unfoldable (Either a) where
  unfold :: f a -> f (Either a a)
unfold f a
fa = [f (Either a a)] -> f (Either a a)
forall (f :: * -> *) a. Unfolder f => [f a] -> f a
choose
    [ a -> Either a a
forall a b. a -> Either a b
Left (a -> Either a a) -> f a -> f (Either a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
forall (f :: * -> *) a. (Unfolder f, Bounded a, Enum a) => f a
boundedEnum
    , a -> Either a a
forall a b. b -> Either a b
Right (a -> Either a a) -> f a -> f (Either a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa
    ]

instance (Bounded a, Enum a) => Unfoldable ((,) a) where
  unfold :: f a -> f (a, a)
unfold f a
fa = [f (a, a)] -> f (a, a)
forall (f :: * -> *) a. Unfolder f => [f a] -> f a
choose
    [ (,) (a -> a -> (a, a)) -> f a -> f (a -> (a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
forall (f :: * -> *) a. (Unfolder f, Bounded a, Enum a) => f a
boundedEnum f (a -> (a, a)) -> f a -> f (a, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
fa ]

instance Unfoldable Identity where
  unfold :: f a -> f (Identity a)
unfold f a
fa = [f (Identity a)] -> f (Identity a)
forall (f :: * -> *) a. Unfolder f => [f a] -> f a
choose
    [ a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> f a -> f (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa ]

instance (Bounded a, Enum a) => Unfoldable (Constant a) where
  unfold :: f a -> f (Constant a a)
unfold f a
_ = [f (Constant a a)] -> f (Constant a a)
forall (f :: * -> *) a. Unfolder f => [f a] -> f a
choose
    [ a -> Constant a a
forall k a (b :: k). a -> Constant a b
Constant (a -> Constant a a) -> f a -> f (Constant a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
forall (f :: * -> *) a. (Unfolder f, Bounded a, Enum a) => f a
boundedEnum ]

instance (Unfoldable p, Unfoldable q) => Unfoldable (Product p q) where
  unfold :: f a -> f (Product p q a)
unfold f a
fa = [f (Product p q a)] -> f (Product p q a)
forall (f :: * -> *) a. Unfolder f => [f a] -> f a
choose
    [ p a -> q a -> Product p q a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (p a -> q a -> Product p q a)
-> f (p a) -> f (q a -> Product p q a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> f (p a)
forall (t :: * -> *) (f :: * -> *) a.
(Unfoldable t, Unfolder f) =>
f a -> f (t a)
unfold f a
fa f (q a -> Product p q a) -> f (q a) -> f (Product p q a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a -> f (q a)
forall (t :: * -> *) (f :: * -> *) a.
(Unfoldable t, Unfolder f) =>
f a -> f (t a)
unfold f a
fa ]

instance (Unfoldable p, Unfoldable q) => Unfoldable (Sum p q) where
  unfold :: f a -> f (Sum p q a)
unfold f a
fa = [f (Sum p q a)] -> f (Sum p q a)
forall (f :: * -> *) a. Unfolder f => [f a] -> f a
choose
    [ p a -> Sum p q a
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (p a -> Sum p q a) -> f (p a) -> f (Sum p q a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> f (p a)
forall (t :: * -> *) (f :: * -> *) a.
(Unfoldable t, Unfolder f) =>
f a -> f (t a)
unfold f a
fa
    , q a -> Sum p q a
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (q a -> Sum p q a) -> f (q a) -> f (Sum p q a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> f (q a)
forall (t :: * -> *) (f :: * -> *) a.
(Unfoldable t, Unfolder f) =>
f a -> f (t a)
unfold f a
fa
    ]

instance (Unfoldable p, Unfoldable q) => Unfoldable (Compose p q) where
  unfold :: f a -> f (Compose p q a)
unfold f a
fa = [f (Compose p q a)] -> f (Compose p q a)
forall (f :: * -> *) a. Unfolder f => [f a] -> f a
choose
    [ p (q a) -> Compose p q a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (p (q a) -> Compose p q a) -> f (p (q a)) -> f (Compose p q a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (q a) -> f (p (q a))
forall (t :: * -> *) (f :: * -> *) a.
(Unfoldable t, Unfolder f) =>
f a -> f (t a)
unfold (f a -> f (q a)
forall (t :: * -> *) (f :: * -> *) a.
(Unfoldable t, Unfolder f) =>
f a -> f (t a)
unfold f a
fa) ]

instance Unfoldable f => Unfoldable (Reverse f) where
  unfold :: f a -> f (Reverse f a)
unfold f a
fa = [f (Reverse f a)] -> f (Reverse f a)
forall (f :: * -> *) a. Unfolder f => [f a] -> f a
choose
    [ f a -> Reverse f a
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (f a -> Reverse f a) -> f (f a) -> f (Reverse f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DualA f (f a) -> f (f a)
forall (f :: * -> *) a. DualA f a -> f a
getDualA (DualA f a -> DualA f (f a)
forall (t :: * -> *) (f :: * -> *) a.
(Unfoldable t, Unfolder f) =>
f a -> f (t a)
unfold (f a -> DualA f a
forall (f :: * -> *) a. f a -> DualA f a
DualA f a
fa)) ]

instance Unfoldable S.Seq where
  unfold :: f a -> f (Seq a)
unfold f a
fa = f (Seq a)
go where
    go :: f (Seq a)
go = [f (Seq a)] -> f (Seq a)
forall (f :: * -> *) a. Unfolder f => [f a] -> f a
choose
      [ Seq a -> f (Seq a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq a
forall (f :: * -> *) a. Alternative f => f a
empty
      , a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
(S.<|) (a -> Seq a -> Seq a) -> f a -> f (Seq a -> Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa f (Seq a -> Seq a) -> f (Seq a) -> f (Seq a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (Seq a)
go ]

instance Unfoldable T.Tree where
  unfold :: f a -> f (Tree a)
unfold f a
fa = f (Tree a)
go where
    go :: f (Tree a)
go = [f (Tree a)] -> f (Tree a)
forall (f :: * -> *) a. Unfolder f => [f a] -> f a
choose [ a -> Forest a -> Tree a
forall a. a -> Forest a -> Tree a
T.Node (a -> Forest a -> Tree a) -> f a -> f (Forest a -> Tree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa f (Forest a -> Tree a) -> f (Forest a) -> f (Tree a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (Tree a) -> f (Forest a)
forall (t :: * -> *) (f :: * -> *) a.
(Unfoldable t, Unfolder f) =>
f a -> f (t a)
unfold f (Tree a)
go ]