{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 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/>.

-- | Imports that are supposed to be used in all wire-server code.
module Imports
  ( -- * Base
    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.Either.Combinators,
    module Data.Foldable,
    module Data.Traversable,
    module Data.Tuple,
    module Data.String,
    module Data.List,
    Generic,
    Typeable,
    HasCallStack,
    readMaybe,
    readEither,

    -- * Transformers, 'MonadIO' and 'UnliftIO'
    module Control.Monad.Trans,
    module Control.Monad.Reader.Class,
    module Control.Monad.Trans.Reader,
    module Control.Monad.IO.Unlift,

    -- * deepseq
    module Control.DeepSeq,

    -- * IO
    module UnliftIO.IO,
    module UnliftIO.Directory,

    -- ** Prelude
    putStr,
    putStrLn,
    print,
    getLine,
    readFile,
    writeFile,
    appendFile,

    -- ** Environment
    getArgs,
    getEnv,
    lookupEnv,
    setEnv,
    unsetEnv,

    -- ** Concurrency primitives
    ThreadId,
    forkIO,
    forkOS,
    killThread,
    threadDelay,

    -- ** Variables
    module UnliftIO.IORef,
    module UnliftIO.MVar,

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

    -- * STM
    module UnliftIO.STM,

    -- * Containers
    Map,
    Set,
    HashMap,
    HashSet,
    ByteString,
    LByteString,
    Text,
    LText,

    -- * Extra Helpers
    whenM,
    unlessM,

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

    -- * development
    todo,
    pattern TODO,
    TodoException (..),
  )
where

-- common in some libs
import Control.Applicative hiding (empty, many, optional, some)
import Control.DeepSeq (NFData (..), deepseq)
import Control.Exception
import Control.Monad hiding (forM, forM_, mapM, mapM_, msum, sequence, sequence_)
import Control.Monad.Extra (unlessM, whenM)
import Control.Monad.IO.Unlift
import Control.Monad.Reader.Class
import Control.Monad.Trans
import Control.Monad.Trans.Reader
  ( Reader,
    ReaderT (ReaderT),
    mapReader,
    mapReaderT,
    runReader,
    runReaderT,
    withReader,
    withReaderT,
  )
import Data.Bifunctor hiding (first, second)
import Data.Bool
import Data.ByteString (ByteString)
import Data.ByteString.Lazy qualified
import Data.Char
import Data.Either
import Data.Either.Combinators hiding (fromLeft, fromRight, isLeft, isRight)
import Data.Foldable
import Data.Function
import Data.Functor
import Data.Functor.Identity
import Data.HashMap.Strict (HashMap)
import Data.HashSet (HashSet)
import Data.Int
import Data.Kind (Type)
import Data.List hiding (delete, insert, singleton)
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.Text (Text)
import Data.Text.Lazy qualified
import Data.Traversable
import Data.Tuple
import Data.Void
import Data.Word
import GHC.Exts
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import Text.Read (readEither, readMaybe)
import UnliftIO.Concurrent
import UnliftIO.Directory hiding (Permissions)
import UnliftIO.Environment
import UnliftIO.Exception
import UnliftIO.IO hiding (Handle, getMonotonicTime)
import UnliftIO.IORef
import UnliftIO.MVar
import UnliftIO.STM
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 Prelude qualified as P

----------------------------------------------------------------------------
-- Type aliases

type LText = Data.Text.Lazy.Text

type LByteString = Data.ByteString.Lazy.ByteString

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

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

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

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

writeFile :: (MonadIO m) => FilePath -> String -> m ()
writeFile :: forall (m :: * -> *). MonadIO m => String -> String -> m ()
writeFile = (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall a b. (a -> b) -> (String -> a) -> String -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((String -> IO ()) -> String -> m ())
-> (String -> String -> IO ()) -> String -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
P.writeFile

appendFile :: (MonadIO m) => FilePath -> String -> m ()
appendFile :: forall (m :: * -> *). MonadIO m => String -> String -> m ()
appendFile = (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall a b. (a -> b) -> (String -> a) -> String -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((String -> IO ()) -> String -> m ())
-> (String -> String -> IO ()) -> String -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
P.appendFile

----------------------------------------------------------------------
-- placeholders

-- | 'todo' indicates unfinished code.
--
-- It is to be used whenever you want to indicate that you are missing a part of
-- the implementation and want to fill that in later.
--
-- This takes a middle ground between other alternatives - unlike typed holes it doesn't cause
-- a /compile time error/, but in contrast to 'GHC.Err.error' and 'GHC.Err.undefined', it does emit
-- a /warning at compilation time/.
--
-- Similarly to all of 'GHC.Err.undefined', 'GHC.Err.error' and typed holes, this /will throw an error/
-- if it is /evaluated at runtime/. This error can only be caught in 'System.IO.IO'.
--
-- This is intended to /never/ stay in code but exists purely for signifying

-- "work in progress" code.
--
-- To make the emitted warning a compile error instead (e.g. for use in CI), add
-- the @-Werror=x-todo@ flag to your @OPTIONS_GHC@.
--
-- ==== __Examples__
--
-- @
-- superComplexFunction :: 'Data.Maybe.Maybe' a -> 'System.IO.IO' 'Data.Int.Int'
-- -- we already know how to implement this in the 'Data.Maybe.Nothing' case
-- superComplexFunction 'Data.Maybe.Nothing' = 'Control.Applicative.pure' 42
-- -- but the 'Data.Maybe.Just' case is super complicated, so we leave it as 'todo' for now
-- superComplexFunction ('Data.Maybe.Just' a) = 'todo'
-- @
--
-- ==== __Representation Polymorphism__
--
-- 'todo', in contrast to 'TODO', is fully representation polymorphic
--
-- @since base-4.21.0.0
todo :: forall {r :: RuntimeRep} (a :: TYPE r). (HasCallStack) => a
todo :: forall a. HasCallStack => a
todo = TodoException -> a
forall a e. Exception e => e -> a
throw TodoException
TodoException
{-# WARNING todo "'todo' left in code" #-}

-- FUTUREWORK(mangoiv): should be: WARNING in "x-todo" from ghc 9.8 on

-- | 'TODO' indicates unfinished code or an unimplemented pattern match
--
-- You can use this in most positions where you could pass 'todo', but it /also/ can be used in
-- the position of a pattern to indicate that there are cases you have not yet considered.
--
-- This pattern synonym is marked @COMPLETE@, implying that every match after matching on 'TODO'
-- will /emit a redundant pattern match warning/. Adding new options to your datatype, similarly
-- to how wildcard patterns (patterns starting with an underscore) work, will /not cause any warnings or errors/.
--
-- ==== __Examples__
--
-- Since the pattern match is strict, even if the branch itself does not evaluate to bottom, matching on
-- 'TODO' will.
--
-- @
-- >>> x = []
-- >>> case x of
-- ...   (x : _) -> x
-- ...   'TODO' -> 42
-- *** Exception: Develop.Placeholder.todo: not yet implemented
-- @
--
-- As usual, this behaviour can be reversed by using a @~@ in front of 'TODO' in pattern position.
--
-- @
-- >>> x = []
-- >>> case x of
-- ...   (x : _) -> x
-- ...   ~'TODO' -> 42
-- 42
-- @
--
-- In most situations, 'TODO' can be used just like 'todo', where the above is equivalent to the below
--
-- @
-- >>> y :: 'Data.Int.Int' = 'todo'
-- >>> x :: 'Data.Int.Int' = 'TODO'
-- @
--
--
-- ==== __Representation Polymorphism__
--
-- Mind that pattern synonyms may not be representation polymorphic, hence, if you need something
-- that can be used with some kind other than 'Data.Kind.Type', you have to use 'todo'. For example,
-- 'TODO' cannot stand instead of a pattern match on an @'GHC.Exts.Int#' :: 'TYPE' 'GHC.Exts.IntRep'@
-- or as a placeholder for a @'GHC.Exts.ByteArray#' :: 'GHC.Exts.UnliftedType'@
--
-- @since base-4.21.0.0
pattern TODO :: forall (a :: Type). (HasCallStack) => forall. a
pattern $mTODO :: forall {r} {a}.
HasCallStack =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bTODO :: forall a. HasCallStack => a
TODO <- (throw TodoException -> !_unused)
  where
    TODO = TodoException -> a
forall a e. Exception e => e -> a
throw TodoException
TodoException
{-# WARNING TODO "'TODO' left in code" #-}

-- FUTUREWORK(mangoiv): should be WARNING in "x-todo" from ghc 9.8 on

{-# COMPLETE TODO #-}

-- | This is the 'Exception' thrown by 'todo'.
--
-- This exception occurring indicates a bug as 'todo' should /never/ remain in code.
--
-- @since base-4.21.0.0
data TodoException = TodoException
  deriving stock (TodoException -> TodoException -> Bool
(TodoException -> TodoException -> Bool)
-> (TodoException -> TodoException -> Bool) -> Eq TodoException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TodoException -> TodoException -> Bool
== :: TodoException -> TodoException -> Bool
$c/= :: TodoException -> TodoException -> Bool
/= :: TodoException -> TodoException -> Bool
Eq, Int -> TodoException -> ShowS
[TodoException] -> ShowS
TodoException -> String
(Int -> TodoException -> ShowS)
-> (TodoException -> String)
-> ([TodoException] -> ShowS)
-> Show TodoException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TodoException -> ShowS
showsPrec :: Int -> TodoException -> ShowS
$cshow :: TodoException -> String
show :: TodoException -> String
$cshowList :: [TodoException] -> ShowS
showList :: [TodoException] -> ShowS
Show)

instance Exception TodoException where
  displayException :: TodoException -> String
displayException TodoException
_ = String
"Develop.Placeholder.todo: not yet implemented"

----------------------------------------------------------------------
-- 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 <$$$>