{-# LANGUAGE NoImplicitPrelude #-}

module Precursor.Control.Alternative
  ( -- * Alternative class
    Alternative
  , (<|>)
  , empty
  , some
  , many
    -- * Utility functions
  , optional
  , afilter
  , asum
  , guard
  , ensure
  , eitherA
  , toAlt
  , mapAlt
  ) where

import           Precursor.Control.Applicative
import           Precursor.Data.Bool
import           Precursor.Control.Category
import           Control.Applicative
import           Control.Monad       (guard)
import           Data.Foldable       (asum)
import           Data.Monoid         (getAlt)
import           Precursor.Data.Either
import           Precursor.Structure.Foldable
import           Precursor.Control.Functor
import           Precursor.Control.Monad

-- $setup
-- >>> import Precursor.Numeric.Integral
-- >>> import Precursor.Numeric.Num
-- >>> import Precursor.Data.List
-- >>> import Test.QuickCheck

-- | A generalized version of 'filter', which works on anything which is
-- both a 'Monad' and 'Alternative'.
--
-- prop> \(Blind p) xs -> filter p xs === afilter p xs
afilter :: (Monad m, Alternative m) => (a -> Bool) -> m a -> m a
afilter p = (=<<) (\x -> bool (pure x) empty (p x))

-- | 'ensure' allows you to attach a condition to something
ensure :: (Alternative f) => (a -> Bool) -> a -> f a
ensure p x = x <$ guard (p x)

-- | 'eitherA' is especially useful for parsers.
eitherA :: Alternative f => f a -> f b -> f (Either a b)
eitherA x y = fmap Left x <|> fmap Right y

-- | Convert any 'Foldable' to an 'Alternative'
toAlt :: (Alternative f, Foldable t) => t a -> f a
toAlt = getAlt . foldMap pure

-- | Map a function over a monad, and concat the results. This is a
-- generalized form of the function 'Data.Maybe.mapMaybe'.
mapAlt :: (Monad m, Alternative m, Foldable f) => (a -> f b) -> m a -> m b
mapAlt f = (=<<) (toAlt . f)