-- |
-- Module      :  Data.List.InnToOut.Unsafe
-- Copyright   :  (c) OleksandrZhabenko 2019-2023
-- License     :  MIT
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- Various additional operations on lists that have additional intermediate Monads inside. 
-- Like the 'unsafePerformIO' function they can have unpredictable behaviour. Use them ONLY if you surely know what you are doing.
--
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK -show-extensions #-}

module Data.List.InnToOut.Unsafe 
  (
    -- * Unsafe (in general) operations that can lead to intermediate Monads. 
       unsafeMapI22M
       ,unsafeMapI2M2
       ,unsafeMapI2M2M   
       ,unsafeMapI12M
       ,unsafeMapI2M1
  ) where

import GHC.Base
import GHC.List (concatMap)

-- | Unsafe function in which the second intermediate result @c@ is in the @Monad m@. It appears if the predicate @p :: a -> Bool@ is @False@ on @a@.
-- It can have unpredictable behaviour. Use it ONLY if you surely know what you are doing. It's your responsibility to check whether 
-- the code does what you expect.
unsafeMapI22M :: Monad m => (a -> Bool) -> (a -> b) -> (b -> d) -> (a -> m c) -> (m c -> d) -> [a] -> [d]
unsafeMapI22M :: forall (m :: * -> *) a b d c.
Monad m =>
(a -> Bool)
-> (a -> b) -> (b -> d) -> (a -> m c) -> (m c -> d) -> [a] -> [d]
unsafeMapI22M a -> Bool
p a -> b
f1 b -> d
g a -> m c
f2 m c -> d
h = forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> if a -> Bool
p a
x then b -> d
g (a -> b
f1 a
x) else m c -> d
h (a -> m c
f2 a
x)) 
{-# INLINABLE unsafeMapI22M #-}

-- | Unsafe function in which the first intermediate result @b@ is in the @Monad m@. It appears if the predicate @p :: a -> Bool@ is @True@ on @a@.
-- It can have unpredictable behaviour. Use it ONLY if you surely know what you are doing. It's your responsibility to check whether 
-- the code does what you expect.
unsafeMapI2M2 :: Monad m => (a -> Bool) -> (a -> m b) -> (m b -> d) -> (a -> c) -> (c -> d) -> [a] -> [d]
unsafeMapI2M2 :: forall (m :: * -> *) a b d c.
Monad m =>
(a -> Bool)
-> (a -> m b) -> (m b -> d) -> (a -> c) -> (c -> d) -> [a] -> [d]
unsafeMapI2M2 a -> Bool
p a -> m b
f1 m b -> d
g a -> c
f2 c -> d
h = forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> if a -> Bool
p a
x then m b -> d
g (a -> m b
f1 a
x) else c -> d
h (a -> c
f2 a
x)) 
{-# INLINABLE unsafeMapI2M2 #-}

-- | Unsafe function in which both the intermediate results @b@ and @c@ are in the Monads. They appear whenever the predicate @p :: a -> Bool@ is @True@ or @False@, but 
-- the first one is used if @p a = True@ and the second one -- if @p a = False@.
-- It can have unpredictable behaviour. Use it ONLY if you surely know what you are doing. It's your responsibility to check whether 
-- the code does what you expect.
unsafeMapI2M2M :: (Monad m0, Monad m) => (a -> Bool) -> (a -> m0 b) -> (m0 b -> d) -> (a -> m c) -> (m c -> d) -> [a] -> [d]
unsafeMapI2M2M :: forall (m0 :: * -> *) (m :: * -> *) a b d c.
(Monad m0, Monad m) =>
(a -> Bool)
-> (a -> m0 b)
-> (m0 b -> d)
-> (a -> m c)
-> (m c -> d)
-> [a]
-> [d]
unsafeMapI2M2M a -> Bool
p a -> m0 b
f1 m0 b -> d
g a -> m c
f2 m c -> d
h = forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> if a -> Bool
p a
x then m0 b -> d
g (a -> m0 b
f1 a
x) else m c -> d
h (a -> m c
f2 a
x)) 
{-# INLINABLE unsafeMapI2M2M #-}

-- | Unsafe function in which the second intermediate result @b@ is in the @Monad m@. It appears if the predicate @p :: a -> Bool@ is @False@ on @a@.
-- It can have unpredictable behaviour. Use it ONLY if you surely know what you are doing. It's your responsibility to check whether 
-- the code does what you expect.
unsafeMapI12M :: Monad m => (a -> Bool) -> (a -> c) -> (a -> m b) -> (m b -> c) -> [a] -> [c]
unsafeMapI12M :: forall (m :: * -> *) a c b.
Monad m =>
(a -> Bool) -> (a -> c) -> (a -> m b) -> (m b -> c) -> [a] -> [c]
unsafeMapI12M a -> Bool
p a -> c
f a -> m b
g m b -> c
h = forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> if a -> Bool
p a
x then a -> c
f a
x else m b -> c
h (a -> m b
g a
x)) 
{-# INLINABLE unsafeMapI12M #-}

-- | Unsafe function in which the first intermediate result @b@ is in the @Monad m@. It appears if the predicate @p :: a -> Bool@ is @True@ on @a@.
-- It can have unpredictable behaviour. Use it ONLY if you surely know what you are doing. It's your responsibility to check whether 
-- the code does what you expect.
unsafeMapI2M1 :: Monad m => (a -> Bool) -> (a -> m b) -> (m b -> c) -> (a -> c) -> [a] -> [c]
unsafeMapI2M1 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> Bool) -> (a -> m b) -> (m b -> c) -> (a -> c) -> [a] -> [c]
unsafeMapI2M1 a -> Bool
p a -> m b
f m b -> c
g a -> c
h = forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> if a -> Bool
p a
x then m b -> c
g (a -> m b
f a
x) else a -> c
h a
x) 
{-# INLINABLE unsafeMapI2M1 #-}