module Data.Homeomorphic.Internal where

import Test.QuickCheck


-- | The central data type. All data structures must be converted so they
--   consist of @Shell@\'s, which split a value into a component at this
--   level and the children. Create a @Shell@ with 'shell'.
data Shell a = Shell a Int [Shell a]
               deriving (Eq, Ord, Show)

instance Arbitrary a => Arbitrary (Shell a) where
    arbitrary = sized $ \s -> do
        x <- arbitrary
        let c = resize (s `div` 2) arbitrary
        xs <- oneof $ map sequence $ take s [[], [c], [c,c], [c,c,c]]
        return $ shell x xs

    coarbitrary (Shell a b c) =
        error "Data.Homeomorphic.Internal.Arbitrary.coarbitrary: Not implemented"


-- | Create a value with a component at the current level
--   and all the children.
shell :: a -> [Shell a] -> Shell a
shell a b = Shell a (length b) b


-- | A simple homeomorphic embedding. /O(expensive)/
(<<|) :: Eq a => Shell a -> Shell a -> Bool
(<<|) x y = dive x y || couple x y

-- | Does the dive rule apply.
dive :: Eq a => Shell a -> Shell a -> Bool
dive x (Shell _ _ ys) = any (x <<|) ys

-- | Does the couple rule apply.
couple :: Eq a => Shell a -> Shell a -> Bool
couple (Shell x1 x2 x3) (Shell y1 y2 y3) = x1 == y1 && x2 == y2 && and (zipWith (<<|) x3 y3)