-- | This module is presents a prelude mostly like the post-Applicative-Monad world of
-- base >= 4.8 / ghc >= 7.10, as well as the post-Semigroup-Monoid world of
-- base >= 4.11 / ghc >= 8.4, even on earlier versions. It's intended as an internal library
-- for llvm-hs-pure and llvm-hs; it's exposed only to be shared between the two.
module LLVM.Prelude (
    module Prelude,
    module Data.Data,
    module GHC.Generics,
    module Data.Int,
    module Data.Word,
    module Data.Functor,
    module Data.Foldable,
    module Data.Semigroup,
    module Data.Traversable,
    module Control.Applicative,
    module Control.Monad,
    ByteString,
    ShortByteString,
    fromMaybe,
    leftBiasedZip,
    findM,
    ifM
    ) where

import Prelude hiding (
    mapM, mapM_,
    sequence, sequence_,
    concat,
    foldr, foldr1, foldl, foldl1,
    minimum, maximum, sum, product, all, any, and, or,
    concatMap,
    elem, notElem,
  )
import Data.Data (Data, Typeable)
import GHC.Generics (Generic)
import Data.Int
import Data.Maybe (fromMaybe)
import Data.Word
import Data.Functor
import Data.Foldable
import Data.Semigroup (Semigroup((<>)))
import Data.Traversable
import Control.Applicative
import Control.Monad hiding (
    forM, forM_,
    mapM, mapM_,
    sequence, sequence_,
    msum
  )

import Data.ByteString (ByteString)
import Data.ByteString.Short (ShortByteString)

leftBiasedZip :: [a] -> [b] -> [(a, Maybe b)]
leftBiasedZip :: [a] -> [b] -> [(a, Maybe b)]
leftBiasedZip [] _ = []
leftBiasedZip xs :: [a]
xs [] = (a -> (a, Maybe b)) -> [a] -> [(a, Maybe b)]
forall a b. (a -> b) -> [a] -> [b]
map (, Maybe b
forall a. Maybe a
Nothing) [a]
xs
leftBiasedZip (x :: a
x:xs :: [a]
xs) (y :: b
y:ys :: [b]
ys) = (a
x, b -> Maybe b
forall a. a -> Maybe a
Just b
y) (a, Maybe b) -> [(a, Maybe b)] -> [(a, Maybe b)]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [(a, Maybe b)]
forall a b. [a] -> [b] -> [(a, Maybe b)]
leftBiasedZip [a]
xs [b]
ys

ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM :: m Bool -> m a -> m a -> m a
ifM cond :: m Bool
cond ifTrue :: m a
ifTrue ifFalse :: m a
ifFalse = do
  Bool
cond' <- m Bool
cond
  if Bool
cond'
    then m a
ifTrue
    else m a
ifFalse

findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
findM :: (a -> m Bool) -> [a] -> m (Maybe a)
findM _ [] = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
findM p :: a -> m Bool
p (x :: a
x:xs :: [a]
xs) = m Bool -> m (Maybe a) -> m (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (a -> m Bool
p a
x) (Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
x) ((a -> m Bool) -> [a] -> m (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM a -> m Bool
p [a]
xs)