-- |
-- Module      :  Data.List.InnToOut.Basic
-- Copyright   :  (c) Oleksandr Zhabenko 2019-2023
-- License     :  MIT
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- Various additional operations on lists
--

{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK -show-extensions #-}

module Data.List.InnToOut.Basic 
  (
    -- * Operations to apply a function or two different functions to an element of the outer list (some of them create inner list)  
       mapI
       , mapI2
  ) where

import GHC.Base
import GHC.List (concatMap)

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

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