-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Testlib.Prelude
  ( module Testlib.App,
    module Testlib.Env,
    module Testlib.Cannon,
    module Testlib.Assertions,
    module Testlib.Types,
    module Testlib.ModService,
    module Testlib.HTTP,
    module Testlib.JSON,
    module Testlib.PTest,
    module Data.Aeson,
    module Prelude,
    module Control.Applicative,
    module Control.Monad,
    module Data.Functor,
    module Data.Bifunctor,
    module Data.Function,
    module Data.Functor.Identity,
    module Data.Int,
    module Data.Word,
    module Data.Void,
    module Data.Bool,
    module Data.Char,
    module Data.Ord,
    module Data.Semigroup,
    module Data.Monoid,
    module Data.Maybe,
    module Data.Either,
    module Data.Foldable,
    module Data.Traversable,
    module Data.Tuple,
    module Data.String,
    module Data.List,
    Default (..),
    Generic,
    Typeable,
    HasCallStack,

    -- * Containers
    Map,
    Set,
    ByteString,

    -- * Exceptions
    Exception (..),
    SomeException (..),
    SomeAsyncException (..),
    IOException,

    -- ** Prelude
    putChar,
    putStr,
    putStrLn,
    print,
    liftIO,

    -- * Functor
    (<$$>),
    (<$$$>),

    -- * Applicative
    allPreds,
  )
where

import Control.Applicative hiding (empty, many, optional, some)
import Control.Monad hiding (forM, forM_, mapM, mapM_, msum, sequence, sequence_)
-- 'insert' and 'delete' are common in database modules

-- Lazy and strict versions are the same

-- First and Last are going to be deprecated. Use Semigroup instead

-- conflicts with Options.Applicative.Option (should we care?)

-- Permissions is common in Galley

-- Handle is hidden because it's common in Brig
-- Explicitly saying what to import because some things from Prelude clash
-- with e.g. UnliftIO modules

import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Aeson hiding ((.=))
import Data.Bifunctor hiding (first, second)
import Data.Bool
import Data.ByteString (ByteString)
import Data.Char
import Data.Default
import Data.Either
import Data.Foldable
import Data.Function
import Data.Functor
import Data.Functor.Identity
import Data.Int
import Data.List hiding (delete, insert, singleton, unzip)
import Data.Map (Map)
import Data.Maybe
import Data.Monoid hiding (First (..), Last (..))
import Data.Ord
import Data.Semigroup hiding (diff)
import Data.Set (Set)
import Data.String
import Data.Traversable
import Data.Tuple
import Data.Void
import Data.Word
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import Testlib.App
import Testlib.Assertions
import Testlib.Cannon
import Testlib.Env
import Testlib.HTTP
import Testlib.JSON
import Testlib.ModService
import Testlib.PTest
import Testlib.Types
import UnliftIO.Exception
import Prelude
  ( Bounded (..),
    Double,
    Enum (..),
    Eq (..),
    FilePath,
    Float,
    Floating (..),
    Fractional (..),
    IO,
    Integer,
    Integral (..),
    Num (..),
    Ord (..),
    Rational,
    Read (..),
    ReadS,
    Real (..),
    RealFloat (..),
    RealFrac (..),
    Show (..),
    ShowS,
    error,
    even,
    fromIntegral,
    gcd,
    lcm,
    lex,
    odd,
    read,
    readParen,
    reads,
    realToFrac,
    seq,
    showChar,
    showParen,
    showString,
    shows,
    subtract,
    undefined,
    ($!),
    (^),
    (^^),
  )
import qualified Prelude as P

----------------------------------------------------------------------------
-- Lifted functions from Prelude

putChar :: (MonadIO m) => Char -> m ()
putChar :: forall (m :: * -> *). MonadIO m => Char -> m ()
putChar = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Char -> IO ()) -> Char -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> IO ()
P.putChar

putStr :: (MonadIO m) => String -> m ()
putStr :: forall (m :: * -> *). MonadIO m => String -> m ()
putStr = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
P.putStr

putStrLn :: (MonadIO m) => String -> m ()
putStrLn :: forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
P.putStrLn

print :: (Show a, MonadIO m) => a -> m ()
print :: forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
print = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO ()
forall a. Show a => a -> IO ()
P.print

----------------------------------------------------------------------
-- Functor

(<$$>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
<$$> :: forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
(<$$>) = (g a -> g b) -> f (g a) -> f (g b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((g a -> g b) -> f (g a) -> f (g b))
-> ((a -> b) -> g a -> g b) -> (a -> b) -> f (g a) -> f (g b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> g a -> g b
forall a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

infix 4 <$$>

(<$$$>) :: (Functor f, Functor g, Functor h) => (a -> b) -> f (g (h a)) -> f (g (h b))
<$$$> :: forall (f :: * -> *) (g :: * -> *) (h :: * -> *) a b.
(Functor f, Functor g, Functor h) =>
(a -> b) -> f (g (h a)) -> f (g (h b))
(<$$$>) = (g (h a) -> g (h b)) -> f (g (h a)) -> f (g (h b))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((g (h a) -> g (h b)) -> f (g (h a)) -> f (g (h b)))
-> ((a -> b) -> g (h a) -> g (h b))
-> (a -> b)
-> f (g (h a))
-> f (g (h b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (h a -> h b) -> g (h a) -> g (h b)
forall a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((h a -> h b) -> g (h a) -> g (h b))
-> ((a -> b) -> h a -> h b) -> (a -> b) -> g (h a) -> g (h b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> h a -> h b
forall a b. (a -> b) -> h a -> h b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

infix 4 <$$$>

----------------------------------------------------------------------
-- Applicative

allPreds :: (Applicative f) => [a -> f Bool] -> a -> f Bool
allPreds :: forall (f :: * -> *) a.
Applicative f =>
[a -> f Bool] -> a -> f Bool
allPreds [] a
_ = Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
allPreds [a -> f Bool
p] a
x = a -> f Bool
p a
x
allPreds (a -> f Bool
p1 : [a -> f Bool]
ps) a
x = Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> f Bool -> f (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f Bool
p1 a
x f (Bool -> Bool) -> f Bool -> f Bool
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a -> f Bool] -> a -> f Bool
forall (f :: * -> *) a.
Applicative f =>
[a -> f Bool] -> a -> f Bool
allPreds [a -> f Bool]
ps a
x