module System.FileSystem.Utils
   ( bind
   , comb
   , tup3
   , apget
   , options
   , (<|>)
   , ($$)
   , pairMap
     ) where

import Control.Applicative (Applicative,liftA2,(<$>))
import Control.Arrow ( (&&&) , (|||) , (***) , arr
                     , Arrow , (<<<) , ArrowChoice )
import Control.Monad.State (MonadState,get,zipWithM)
import Data.Maybe (catMaybes,listToMaybe)
import Control.Monad (join)

-- | The '=<<' operator as a function.
bind :: Monad m => (a -> m b) -> m a -> m b
bind = (=<<)

-- | The resulting function of 'comb' is such that it applies two (possible) different functions
-- to a single element, and combine both results with the given operator, inside of an 'Applicative' container.
comb :: Applicative f
     => (b -> c -> d) -- ^ The operator.
     -> (a -> f b)    -- ^ The first function.
     -> (a -> f c)    -- ^ The second function.
     -> (a -> f d)    -- ^ The resulting function.
comb op f g = uncurry (liftA2 op) . (f &&& g)

-- | Given a list @xs@ of pairs (monadic condition, monadic function),
-- 'options' @xs@ applies to its argument the first function that
-- satisfy the condition, and returns 'Nothing' if no condition was satisfied.
options :: (Functor m, Monad m)
        => [ ( a -> m Bool , a -> m b ) ]
        -> (a -> m (Maybe b))
options = flip $ \a ->
          fmap (listToMaybe . catMaybes)
        . mapM (uncurry $
                 \c f -> do b <- c a
                            if b then Just <$> f a
                                 else return Nothing)

-- | This function just adds a third component to a two-components tuple.
tup3 :: c -> (a,b) -> (a,b,c)
tup3 c (a,b) = (a,b,c)

-- | Apply a function over the state, and return its result.
apget :: (Functor m, MonadState s m) => (s -> a) -> m a
apget = (<$> get)

infixr 1 <|>
-- | An 'ArrowChoice' operator.
-- Given an arrow @a ~> b@ and an arrow @c ~> d@:
-- 
-- > a ~> b <|> c ~> d
-- >  = Either a c ~> Either b d    { (a ~> b) lifted with Left for Left values.
-- >                          with -{          
-- >                                { (c ~> d) lifted with Right for Right values.
--
-- /Its name comes from the union of/ '<$>' /and/ '|||'.
(<|>) :: ArrowChoice f => f a b -> f c d -> f (Either a c) (Either b d)
f <|> g = (arr Left <<< f) ||| (arr Right <<< g)

-- | Transforms a simple arrow to the same arrow applied to the two components of a pair.
pairMap :: Arrow f => f a b -> f (a,a) (b,b)
pairMap f = f *** f

-- | This operator is similar to '$', but the argument is used twice.
($$) :: (a -> a -> b) -> a -> b
f $$ x = f x x