{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances #-}

module Control.Alternative.Pointed
    ( PointedAlternative
    , someLazy
    , manyLazy
    , ascertain
    , ascertainA
    , (<|!>)
    , (<!|>)
    , desperately
    ) where

import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Identity
import qualified Data.List.NonEmpty as NE
import Control.Monad.Trans.State

import Control.Applicative
import Control.Monad.Identity
import Control.Monad
import Data.Maybe
import Control.Monad.Trans.Identity
import Data.List
import Data.Foldable

-- | An alternative functor and something without its empty.
--
-- @coerceToNonempty . @embed == id
--
-- @coerceToNonempty empty == _|_
--
-- 'someLazy' and 'manyLazy' should be the greatest lower bound of the maximally defined fixpoints of the following equations:
--
-- * @someLazy v = (:) '<$>' v '<*>' @manyLazy v@
--
-- * @manyLazy v = @someLazy v '<|>' 'pure' []@
class Alternative f => PointedAlternative f g | f -> g, g -> f where
    -- | Promise that the argument is not empty and embed the rest of f into g. This is used by manyLazy to reflect the fact that the maximum chain of applications that does not become empty does not become empty.
    coerceToNonempty :: f a -> g a

    embed :: g a -> f a

    -- | As many as possible, but not none.
    someLazy :: f a -> f (NE.NonEmpty a)
    someLazy v = coerceToNonempty <$> some_v
      where
        many_v = ascertain [] some_v
        some_v = (:) <$> v <*> embed many_v

    -- | As many as possible.
    manyLazy :: f a -> g [a]
    manyLazy v = many_v
      where
        many_v = ascertain [] some_v
        some_v = (:) <$> v <*> embed many_v

-- Gurantee that an action succeeds by adding a default value.
ascertain :: PointedAlternative f g => a -> f a -> g a
ascertain x = coerceToNonempty . (<|> pure x)

-- = flip (<|!>) = "fromMaybeT"
ascertainA :: PointedAlternative f g => g a -> f a -> g a
ascertainA x = coerceToNonempty . (<|> embed x)

(<!|>) :: PointedAlternative f g => g a -> f a -> g a
x <!|> y = coerceToNonempty $ embed x <|> y

(<|!>) :: PointedAlternative f g => f a -> g a -> g a
x <|!> y = coerceToNonempty $ x <|> embed y

-- Gurantee that an action succeeds by adding it to itself infinitely, not halting if it keeps failing.
-- Note that f = [] promises only a NonEmpty, rather than the possible Stream.
desperately :: PointedAlternative f g => f a -> g a
desperately = coerceToNonempty . asum . repeat

instance PointedAlternative Maybe Identity where
  coerceToNonempty = Identity . fromJust
  embed = Just . runIdentity

instance PointedAlternative [] NE.NonEmpty where
  coerceToNonempty (x:xs) = x NE.:| xs
  embed = NE.toList

instance (Functor m, Monad m) => PointedAlternative (MaybeT m) (IdentityT m) where
  coerceToNonempty = IdentityT . liftM fromJust . runMaybeT
  embed = MaybeT . liftM Just . runIdentityT

{-
-- Requires the traversablet package, which might never exist.
instance (Monad f, Traversable f, Monad g, Traversable g, PointedAlternative f g, Functor m, Alternative (TraversableT f m)) => PointedAlternative (TraversableT f m) (TraversableT g m) where
  coerceToNonempty = runTraversableT . fmap coerceToNonempty . TraversableT
  embed            = runTraversableT . fmap embed            . TraversableT
-}

instance (PointedAlternative f g, MonadPlus f) => PointedAlternative (StateT s f) (StateT s g) where
  coerceToNonempty = StateT . (.) coerceToNonempty . runStateT
  embed            = StateT . (.) embed            . runStateT