module Data.Countable where
{
    import Data.Word;
    import Data.Int;
    import Prelude;

    class (Eq a) => Countable a where
    {
        countPrevious :: a -> Maybe a;
        countMaybeNext :: Maybe a -> Maybe a;
    };

    countDown :: (Countable a) => a -> [a];
    countDown a = case countPrevious a of
    {
        Just a' -> a':(countDown a');
        Nothing -> [];
    };

    instance Countable () where
    {
        countPrevious () = Nothing;
        countMaybeNext Nothing = Just ();
        countMaybeNext (Just ()) = Nothing;
    };

    instance Countable Bool where
    {
        countPrevious True = Just False;
        countPrevious False = Nothing;
        countMaybeNext Nothing = Just False;
        countMaybeNext (Just False) = Just True;
        countMaybeNext (Just True) = Nothing;
    };

    boundedCountPrevious :: (Eq a,Bounded a,Enum a) => a -> Maybe a;
    boundedCountPrevious n | n == minBound = Nothing;
    boundedCountPrevious n = Just (pred n);

    boundedCountMaybeNext :: (Eq a,Bounded a,Enum a) => Maybe a -> Maybe a;
    boundedCountMaybeNext Nothing = Just minBound;
    boundedCountMaybeNext (Just n) | n == maxBound = Nothing;
    boundedCountMaybeNext (Just n) = Just (succ n);

    instance Countable Word8 where
    {
        countPrevious = boundedCountPrevious;
        countMaybeNext = boundedCountMaybeNext;
    };

    instance Countable Word16 where
    {
        countPrevious = boundedCountPrevious;
        countMaybeNext = boundedCountMaybeNext;
    };

    instance Countable Word32 where
    {
        countPrevious = boundedCountPrevious;
        countMaybeNext = boundedCountMaybeNext;
    };

    instance Countable Word64 where
    {
        countPrevious = boundedCountPrevious;
        countMaybeNext = boundedCountMaybeNext;
    };

    instance Countable Int8 where
    {
        countPrevious = boundedCountPrevious;
        countMaybeNext = boundedCountMaybeNext;
    };

    instance Countable Int16 where
    {
        countPrevious = boundedCountPrevious;
        countMaybeNext = boundedCountMaybeNext;
    };

    instance Countable Int32 where
    {
        countPrevious = boundedCountPrevious;
        countMaybeNext = boundedCountMaybeNext;
    };

    instance Countable Int64 where
    {
        countPrevious = boundedCountPrevious;
        countMaybeNext = boundedCountMaybeNext;
    };

    instance Countable Integer where
    {
        countPrevious 0 = Nothing;
        countPrevious a | a < 0 = Just (- a - 1);
        countPrevious a = Just (- a);
        countMaybeNext = Just . countNext;
    };

    instance (Countable a) => Countable (Maybe a) where
    {
        countPrevious = fmap countPrevious;
        countMaybeNext Nothing = Just Nothing;
        countMaybeNext (Just ma) = fmap Just (countMaybeNext ma);
    };

    maybeRecount :: (Countable a,Countable b) => a -> Maybe b;
    maybeRecount a = case countPrevious a of
    {
        Just a' -> do
        {
            b' <- maybeRecount a';
            countMaybeNext b';
        };
        Nothing -> countMaybeNext Nothing;
    };

    {-
    Right 0
    Left 0
    Right 1
    Left 1
    Left 2
    Left 3
    -}

    instance (Countable a,Countable b) => Countable (Either a b) where
    {
        countPrevious (Right b) = case countPrevious b of
        {
            Just b' -> case maybeRecount b' of
            {
                Just a -> Just (Left a);
                Nothing -> Just (Right b);
            };
            Nothing -> Nothing;
        };
        countPrevious (Left a) = case maybeRecount a of
        {
            Just b -> Just (Right b);
            Nothing -> fmap Left (countPrevious a);
        };

        countMaybeNext Nothing = case countMaybeNext Nothing of
        {
            Just b -> Just (Right b);
            Nothing -> fmap Left (countMaybeNext Nothing);
        };
        countMaybeNext (Just (Right b)) = case maybeRecount b of
        {
            Just a -> Just (Left a);
            Nothing -> fmap Right (countMaybeNext (Just b));
        };
        countMaybeNext (Just (Left a)) = case maybeRecount a >>= (countMaybeNext . Just) of
        {
            Just b -> (Just (Right b));
            Nothing -> fmap Left (countMaybeNext (Just a));
        };
    };

    countDownUp :: (Countable down,Countable up) => (down,up) -> Maybe (down,up);
    countDownUp (down,up) = do
    {
        down' <- countPrevious down;
        up' <- countMaybeNext (Just up);
        return (down',up');
    };

    countUpDown :: (Countable up,Countable down) => (up,down) -> Maybe (up,down);
    countUpDown (up,down) = do
    {
        up' <- countMaybeNext (Just up);
        down' <- countPrevious down;
        return (up',down');
    };

    finalIteration :: (a -> Maybe a) -> a -> a;
    finalIteration f a = case f a of
    {
        Just a' -> finalIteration f a';
        Nothing -> a;
    };

    instance (Countable a,Countable b) => Countable (a,b) where
    {
        countPrevious ab = case countUpDown ab of
        {
            Just ab' -> Just ab';
            _ -> let
            {
                (a',b') = finalIteration countDownUp ab;
            } in case countPrevious a' of
            {
                Just a'' -> Just (a'',b');
                Nothing -> case countPrevious b' of
                {
                    Just b'' -> Just (a',b'');
                    Nothing -> Nothing;
                };
            };
        };

        countMaybeNext Nothing = do
        {
            a <- countMaybeNext Nothing;
            b <- countMaybeNext Nothing;
            return (a,b);
        };
        countMaybeNext (Just ab) = case countDownUp ab of
        {
            Just ab' -> Just ab';
            _ -> let
            {
                (a',b') = finalIteration countUpDown ab;
            } in case countMaybeNext (Just a') of
            {
                Just a'' -> Just (a'',b');
                Nothing -> case countMaybeNext (Just b') of
                {
                    Just b'' -> Just (a',b'');
                    Nothing -> Nothing;
                };
            };
        };
    };

    class (Countable a) => AtLeastOneCountable a where
    {
        countFirst :: a;
    };

    instance AtLeastOneCountable () where
    {
        countFirst = ();
    };

    instance AtLeastOneCountable Bool where
    {
        countFirst = False;
    };

    instance AtLeastOneCountable Word8 where
    {
        countFirst = minBound;
    };

    instance AtLeastOneCountable Word16 where
    {
        countFirst = minBound;
    };

    instance AtLeastOneCountable Word32 where
    {
        countFirst = minBound;
    };

    instance AtLeastOneCountable Word64 where
    {
        countFirst = minBound;
    };

    instance AtLeastOneCountable Int8 where
    {
        countFirst = minBound;
    };

    instance AtLeastOneCountable Int16 where
    {
        countFirst = minBound;
    };

    instance AtLeastOneCountable Int32 where
    {
        countFirst = minBound;
    };

    instance AtLeastOneCountable Int64 where
    {
        countFirst = minBound;
    };

    instance AtLeastOneCountable Integer where
    {
        countFirst = 0;
    };

    instance (Countable a) => AtLeastOneCountable (Maybe a) where
    {
        countFirst = Nothing;
    };

    instance (Countable a,AtLeastOneCountable b) => AtLeastOneCountable (Either a b) where
    {
        countFirst = Right countFirst;
    };

    instance (AtLeastOneCountable a,AtLeastOneCountable b) => AtLeastOneCountable (a,b) where
    {
        countFirst = (countFirst,countFirst);
    };

    class (AtLeastOneCountable a) => InfiniteCountable a where
    {
        countNext :: Maybe a -> a;
    };

    instance InfiniteCountable Integer where
    {
        countNext Nothing = 0;
        countNext (Just a) | a < 0 = - a;
        countNext (Just a) = - a - 1;
    };

    instance (InfiniteCountable a) => InfiniteCountable (Maybe a) where
    {
        countNext = fmap countNext;
    };

    instance (AtLeastOneCountable a,InfiniteCountable b) => InfiniteCountable (a,b) where
    {
        countNext Nothing = (countFirst,countNext Nothing);
        countNext (Just ab) = case countDownUp ab of
        {
            Just ab' -> ab';
            _ -> let
            {
                (a',b') = finalIteration countUpDown ab;
            } in case countMaybeNext (Just a') of
            {
                Just a'' -> (a'',b');
                Nothing -> (a',countNext (Just b'));
            };
        };
    };

    recount :: (Countable a,InfiniteCountable b) => a -> b;
    recount = countNext . (fmap recount) . countPrevious;

    instance (Countable a,InfiniteCountable b) => InfiniteCountable (Either a b) where
    {
        countNext Nothing = Right (countNext Nothing);
        countNext (Just (Right b)) = case maybeRecount b of
        {
            Just a -> Left a;
            Nothing -> Right (countNext (Just b));
        };
        countNext (Just (Left a)) = Right (countNext (recount a));
    };

    instance (Countable a) => Countable [a] where
    {
        countPrevious [] = Nothing;
        countPrevious (x:xs) = case countMaybeNext Nothing of
        {
            Nothing -> seq x undefined; -- x not supposed to exist
            Just firsta -> Just (pp x xs) where
            {
                pp a r = case countPrevious a of
                {
                    Just a' -> firsta:(pp a' r);
                    Nothing -> case r of
                    {
                        [] -> [];
                        b:r' -> case countMaybeNext (Just b) of
                        {
                            Just b' -> b':r';
                            Nothing -> firsta:(pp b r');
                        };
                    };
                };
            };
        };

        countMaybeNext Nothing = Just [];
        countMaybeNext (Just l) = case countMaybeNext Nothing of
        {
            Nothing -> Nothing;
            Just firsta -> Just (countNext' l) where
            {
                countNext' [] = [firsta];
                countNext' (a:r) = case countPrevious a of
                {
                    Just a' -> firsta:a':r;
                    Nothing -> upOne (countNext' r);
                };

                upOne [] = [firsta];
                upOne (a:r) = case countMaybeNext (Just a) of
                {
                    Just a' -> a':r;
                    Nothing -> firsta:a:r;
                };
            };
        };
    };

    instance (Countable a) => AtLeastOneCountable [a] where
    {
        countFirst = [];
    };

    instance (AtLeastOneCountable a) => InfiniteCountable [a] where
    {
        countNext Nothing = [];
        countNext (Just l) = countNext' l where
        {
            countNext' [] = [countFirst];
            countNext' (a:r) = case countPrevious a of
            {
                Just a' -> countFirst:a':r;
                Nothing -> upOne (countNext' r);
            };

            upOne [] = [countFirst];
            upOne (a:r) = case countMaybeNext (Just a) of
            {
                Just a' -> a':r;
                Nothing -> countFirst:a:r;
            };
        };
    };
}