-- |
-- Module      :  Data.List.InnToOut
-- Copyright   :  (c) OleksandrZhabenko 2019
-- License     :  MIT
--
-- Maintainer  :  olexandr543@yahoo.com
--
-- Various additional operations on lists. Some of them have additional intermediate Monads inside.
--

module Data.List.InnToOut
  (
    -- * Operations to apply a function that creates an inner list to an element of the outer list   
       mapI
       , mapI2
       , mapI22
       , mapI12
       , mapI21
    -- * Operations to obtain intermediate Monads
       , mapI22M
       , mapI2M2
       , mapI2M2M
       , mapI12M
       , mapI2M1
  ) where

-- | Function that applies additional function @f :: a -> [a]@ to @a@ if @p a = True@
mapI :: (a -> Bool) -> (a -> [a]) -> [a] -> [a]
mapI p f = concatMap (\x -> if p x then f x else [x])
{-#INLINE mapI#-}

-- | Function that applies additional function @f :: a -> b@ to @a@ if @p a = True@ and otherwise another function @g :: a -> [b]@  to @[a]@ to obtain @[b]@
mapI2 :: (a -> Bool) -> (a -> b) -> (a -> [b]) -> [a] -> [b]
mapI2 p f g = concatMap (\x -> if p x then [f x] else g x)
{-#INLINE mapI2#-}

-- | Function that can apply two different ways of computing something depending of the predicate value @p :: a -> Bool@ and the structure of transition the data for the @[a]@. 
-- It is used if there are two ways to transform data both of them consists of two applied functoins. Similar to arrow techniques.
mapI22 :: (a -> Bool) -> (a -> b) -> (b -> d) -> (a -> c) -> (c -> d) -> [a] -> [d]
mapI22 p f1 g f2 h = map (\x -> if p x then g (f1 x) else h (f2 x))
{-#INLINE mapI22#-}

-- | Variant of the function 'mapI22' in which the second intermediate result @c@ is in the @Monad m@.
mapI22M :: Monad m => (a -> Bool) -> (a -> b) -> (b -> d) -> (a -> m c) -> (m c -> d) -> [a] -> [d]
mapI22M p f1 g f2 h = map (\x -> if p x then g (f1 x) else h (f2 x))
{-#INLINE mapI22M#-}

-- | Variant of the function 'mapI22' in which the first intermediate result @b@ is in the @Monad m@.
mapI2M2 :: Monad m => (a -> Bool) -> (a -> m b) -> (m b -> d) -> (a -> c) -> (c -> d) -> [a] -> [d]
mapI2M2 p f1 g f2 h = map (\x -> if p x then g (f1 x) else h (f2 x))
{-#INLINE mapI2M2#-}

-- | Variant of the function 'mapI22' in which both the intermediate results @b@ and @c@ are in the Monads.
mapI2M2M :: (Monad m0, Monad m) => (a -> Bool) -> (a -> m0 b) -> (m0 b -> d) -> (a -> m c) -> (m c -> d) -> [a] -> [d]
mapI2M2M p f1 g f2 h = map (\x -> if p x then g (f1 x) else h (f2 x))
{-#INLINE mapI2M2M#-}

-- | Function that can apply two different ways of computing something depending of the predicate value @p :: a -> Bool@ and the structure of transition the data for the @[a]@. 
-- It is used if there are two ways to transform data and the first one consists of one function and another -- from two applied consequently ones. Similar to arrow techniques.
mapI12 :: (a -> Bool) -> (a -> c) -> (a -> b) -> (b -> c) -> [a] -> [c]
mapI12 p f g h = map (\x -> if p x then f x else h (g x))
{-#INLINE mapI12#-}

-- | Variant of the function 'mapI12' in which the second intermediate result @b@ is in the @Monad m@.
mapI12M :: Monad m => (a -> Bool) -> (a -> c) -> (a -> m b) -> (m b -> c) -> [a] -> [c]
mapI12M p f g h = map (\x -> if p x then f x else h (g x))
{-#INLINE mapI12M#-}

-- | Function that can apply two different ways of computing something depending of the predicate value @p :: a -> Bool@ and the structure of transition the data for the @[a]@. 
-- It is used if there are two ways to transform data and the first one consists of two applied consequently functions and the second -- from one applied function. Similar to arrow techniques.
mapI21 :: (a -> Bool) -> (a -> b) -> (b -> c) -> (a -> c) -> [a] -> [c]
mapI21 p f g h = map (\x -> if p x then g (f x) else h x)
{-#INLINE mapI21#-}

-- | Variant of the function 'mapI21' in which the first intermediate result @b@ is in the @Monad m@.
mapI2M1 :: Monad m => (a -> Bool) -> (a -> m b) -> (m b -> c) -> (a -> c) -> [a] -> [c]
mapI2M1 p f g h = map (\x -> if p x then g (f x) else h x)
{-#INLINE mapI2M1#-}