{-# LANGUAGE CPP #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE MagicHash #-}

{- ORMOLU_DISABLE -}

-- | Custom prelude. The idea is to:
--
-- * Re-export useful prelude functions/types
-- * Export various functions/types from base
-- * Export new functions meant to address prelude limitations
--   (e.g. total replacements for partial functions).
--
-- This is not a comprehensive replacement for Prelude, just the
-- functionality needed for this application. Thus it is natural to
-- add new functionality/exports here over time.
module Shrun.Prelude
  ( -- * Total versions of partial functions
    headMaybe,

    -- * Misc utilities
    fromFoldable,
    (<<$>>),
    (<<&>>),
    (.>),
    unsafeConvertIntegral,
    todo,
    setUncaughtExceptionHandlerDisplay,

    -- * 'Text' replacements for 'P.String' functions.
    showt,
    displayExceptiont,

#if !MIN_VERSION_base(4, 20, 0)

    -- * Anti-punning aliases
    List,
    Tuple2,
    Tuple3,

#endif

    -- * Prelude exports
    module X,
  )
where

{- ORMOLU_ENABLE -}

import Control.Applicative as X
  ( Alternative (empty, (<|>)),
    Applicative (liftA2, pure, (*>), (<*>)),
    (<**>),
  )
import Control.Concurrent as X (threadDelay)
import Control.Monad as X
  ( Monad ((>>=)),
    forever,
    join,
    unless,
    void,
    when,
    (<=<),
    (=<<),
    (>=>),
  )
import Control.Monad.Fail as X (MonadFail (fail))
import Control.Monad.IO.Class as X (MonadIO (liftIO))
import Control.Monad.Reader as X
  ( MonadReader (ask, local),
    ReaderT (runReaderT),
    asks,
  )
import Control.Monad.Trans as X (MonadTrans (lift))
import Data.Bifunctor as X (Bifunctor)
import Data.Bits (Bits, toIntegralSized)
import Data.Bool as X (Bool (False, True), not, otherwise, (&&), (||))
import Data.ByteString as X (ByteString)
import Data.Bytes as X
  ( Bytes (MkBytes),
    FromInteger (afromInteger),
    Size (B),
    _MkBytes,
  )
import Data.Char as X (Char)
import Data.Either as X (Either (Left, Right))
import Data.Eq as X (Eq ((/=), (==)))
import Data.Foldable as X
  ( Foldable (fold, foldl', foldr, toList),
    any,
    for_,
    length,
    traverse_,
  )
import Data.Function as X (const, flip, id, ($), (&), (.))
import Data.Functor as X
  ( Functor (fmap),
    ($>),
    (<$>),
    (<&>),
  )
import Data.Int as X (Int)
import Data.Kind as X (Constraint, Type)
#if MIN_VERSION_base(4, 20, 0)
import Data.List as X (List, filter, replicate, zip, (++))
#else
import Data.List as X (filter, replicate, zip, (++))
#endif
import Data.List.NonEmpty as X (NonEmpty ((:|)))
import Data.Maybe as X (Maybe (Just, Nothing), fromMaybe, maybe)
import Data.Monoid as X (Monoid (mconcat, mempty))
import Data.Ord as X (Ord ((<), (<=), (>), (>=)), Ordering)
import Data.Proxy as X (Proxy (Proxy))
import Data.Semigroup as X (Semigroup ((<>)))
import Data.Sequence as X (Seq ((:<|), (:|>)))
import Data.Sequence.NonEmpty as X (NESeq ((:<||), (:||>)), pattern IsEmpty)
import Data.String as X (String)
import Data.Text as X (Text, pack, unpack)
import Data.Text qualified as T
import Data.Traversable as X (Traversable (traverse), for)
import Data.Tuple as X (fst, snd)
#if MIN_VERSION_base(4, 20, 0)
import Data.Tuple.Experimental as X (Tuple2, Tuple3)
#endif
import Data.Type.Equality as X (type (~))
import Data.Void as X (Void, absurd)
import Effects.Concurrent.Async as X (MonadAsync)
import Effects.Concurrent.STM as X
  ( MonadSTM,
    TBQueue,
    TVar,
    flushTBQueueA,
    modifyTVarA',
    newTBQueueA,
    newTVarA,
    readTBQueueA,
    readTVarA,
    writeTBQueueA,
    writeTVarA,
  )
import Effects.Concurrent.Thread as X (MonadThread)
import Effects.Exception as X
  ( Exception (displayException, fromException),
    MonadCatch,
    MonadMask,
    MonadThrow,
    SomeException,
    bracket,
    catchAny,
    catchCS,
    displayException,
    exitFailure,
    finally,
    mask,
    throwCS,
    throwM,
    try,
    tryAny,
  )
import Effects.Exception qualified as Ex
import Effects.FileSystem.FileReader as X
  ( MonadFileReader,
    decodeUtf8Lenient,
    readFileUtf8Lenient,
    readFileUtf8ThrowM,
  )
import Effects.FileSystem.FileWriter as X
  ( MonadFileWriter,
    appendFileUtf8,
    writeFileUtf8,
  )
import Effects.FileSystem.HandleReader as X (MonadHandleReader)
import Effects.FileSystem.HandleWriter as X
  ( MonadHandleWriter (hClose, hFlush, openBinaryFile),
    hPutUtf8,
  )
import Effects.FileSystem.PathReader as X
  ( MonadPathReader (doesDirectoryExist, doesFileExist, getFileSize),
    getXdgConfig,
    getXdgState,
  )
import Effects.FileSystem.PathWriter as X
  ( MonadPathWriter,
    removeDirectoryIfExists,
    removeFile,
    removeFileIfExists,
  )
import Effects.FileSystem.Utils as X (OsPath, decodeUtf8, osp, (</>))
import Effects.IORef as X
  ( IORef,
    MonadIORef
      ( atomicModifyIORef',
        modifyIORef',
        newIORef,
        readIORef,
        writeIORef
      ),
  )
import Effects.Optparse as X (MonadOptparse (execParser))
import Effects.Process.Typed as X (MonadTypedProcess, Process)
import Effects.System.Environment as X (MonadEnv (withArgs))
import Effects.System.Terminal as X
  ( MonadTerminal,
    putStr,
    putStrLn,
    putText,
    putTextLn,
  )
import Effects.Time as X (MonadTime)
import GHC.Enum as X (Bounded (maxBound, minBound), Enum (toEnum))
import GHC.Err as X (error, undefined)
import GHC.Exception (errorCallWithCallStackException)
import GHC.Exts (RuntimeRep, TYPE, raise#)
import GHC.Float as X (Double, Float)
import GHC.Generics as X (Generic)
import GHC.Integer as X (Integer)
import GHC.Natural as X (Natural)
import GHC.Num as X (Num ((*), (+), (-)))
import GHC.Real as X (Integral, truncate)
import GHC.Show as X (Show (show, showsPrec))
import GHC.Stack as X (HasCallStack)
import Optics.Core as X
  ( A_Getter,
    A_Lens,
    A_Setter,
    AffineTraversal',
    An_AffineFold,
    An_AffineTraversal,
    An_Iso,
    Getter,
    Is,
    Iso',
    LabelOptic (labelOptic),
    Lens,
    Lens',
    NoIx,
    Optic',
    Prism,
    Prism',
    iso,
    lensVL,
    over',
    preview,
    prism,
    review,
    set',
    to,
    view,
    (#),
    (%),
    (%!~),
    (%?),
    (.~),
    (?~),
    (^.),
    (^?),
    _1,
    _2,
    _3,
    _Just,
    _Left,
    _Nothing,
    _Right,
  )
import Optics.Core.Extras as X (is)
import System.Console.Regions as X (ConsoleRegion, RegionLayout (Linear))
import System.Exit as X (ExitCode (ExitFailure, ExitSuccess))
import System.IO as X (FilePath, Handle, IO, IOMode (AppendMode, WriteMode), print)
import TOML as X
  ( DecodeTOML (tomlDecoder),
    Decoder,
    TOMLError,
    Value,
    decode,
    decodeWith,
    getArrayOf,
    getField,
    getFieldOpt,
    getFieldOptWith,
    getFieldWith,
    invalidValue,
    makeDecoder,
    renderTOMLError,
    runDecoder,
    typeMismatch,
  )
import Type.Reflection (Typeable)
import Type.Reflection qualified as Typeable
import Prelude as X (seq)

-- $setup
-- >>> import Data.String (String)
-- >>> :set -XNoOverloadedLists

-- | 'Text' version of 'show'.
showt :: (Show a) => a -> Text
showt :: forall a. Show a => a -> Text
showt = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | 'Text' version of 'displayException'.
displayExceptiont :: (Exception e) => e -> Text
displayExceptiont :: forall e. Exception e => e -> Text
displayExceptiont = String -> Text
T.pack (String -> Text) -> (e -> String) -> e -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> String
forall e. Exception e => e -> String
displayException

-- | Safe @head@.
--
-- >>> headMaybe [1,2,3]
-- Just 1
--
-- >>> headMaybe []
-- Nothing
headMaybe :: (Foldable f) => f a -> Maybe a
headMaybe :: forall (f :: Type -> Type) a. Foldable f => f a -> Maybe a
headMaybe = (a -> Maybe a -> Maybe a) -> Maybe a -> f a -> Maybe a
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x Maybe a
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
x) Maybe a
forall a. Maybe a
Nothing

-- | From foldable.
fromFoldable :: (Foldable f) => a -> f a -> a
fromFoldable :: forall (f :: Type -> Type) a. Foldable f => a -> f a -> a
fromFoldable a
x = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
x (Maybe a -> a) -> (f a -> Maybe a) -> f a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Maybe a
forall (f :: Type -> Type) a. Foldable f => f a -> Maybe a
headMaybe

-- | Lifted fmap.
--
-- >>> not <<$>> [Just True, Nothing, Just False]
-- [Just False,Nothing,Just True]
(<<$>>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
<<$>> :: forall (f :: Type -> Type) (g :: Type -> Type) 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 :: Type -> Type) 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 :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap

infixl 4 <<$>>

-- | Flipped '(<<$>>)'; lifted `(<&>)`.
(<<&>>) :: (Functor f, Functor g) => f (g a) -> (a -> b) -> f (g b)
<<&>> :: forall (f :: Type -> Type) (g :: Type -> Type) a b.
(Functor f, Functor g) =>
f (g a) -> (a -> b) -> f (g b)
(<<&>>) = ((a -> b) -> f (g a) -> f (g b)) -> f (g a) -> (a -> b) -> f (g b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> f (g a) -> f (g b)
forall (f :: Type -> Type) (g :: Type -> Type) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
(<<$>>)

-- | Flipped '(.)'
(.>) :: (a -> b) -> (b -> c) -> a -> c
a -> b
f .> :: forall a b c. (a -> b) -> (b -> c) -> a -> c
.> b -> c
g = b -> c
g (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
{-# INLINE (.>) #-}

infixr 9 .>

#if !MIN_VERSION_base(4, 20, 0)

-- | Alias for [].
type List = []

-- | Alias for (,).
type Tuple2 = (,)

-- | Alias for (,,).
type Tuple3 = (,,)

#endif

-- | Like 'fromIntegral', except:
--
--   1. The conversion is only between integral types.
--   2. Errors rather than silently rounds for bounds issues.
unsafeConvertIntegral ::
  forall a b.
  ( Bits a,
    Bits b,
    HasCallStack,
    Integral a,
    Integral b,
    Show a,
    Typeable a,
    Typeable b
  ) =>
  a ->
  b
unsafeConvertIntegral :: forall a b.
(Bits a, Bits b, HasCallStack, Integral a, Integral b, Show a,
 Typeable a, Typeable b) =>
a -> b
unsafeConvertIntegral a
x = case a -> Maybe b
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized a
x of
  Just b
y -> b
y
  Maybe b
Nothing ->
    String -> b
forall a. HasCallStack => String -> a
error (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"Failed converting ",
          a -> String
forall a. Show a => a -> String
show a
x,
          String
" from ",
          TypeRep a -> String
forall a. Show a => a -> String
show (a -> TypeRep a
forall a. Typeable a => a -> TypeRep a
Typeable.typeOf a
x),
          String
" to ",
          TypeRep b -> String
forall a. Show a => a -> String
show (TypeRep b -> String) -> TypeRep b -> String
forall a b. (a -> b) -> a -> b
$ b -> TypeRep b
forall a. Typeable a => a -> TypeRep a
Typeable.typeOf (b
forall a. HasCallStack => a
undefined :: b)
        ]

todo :: forall {r :: RuntimeRep} (a :: TYPE r). (HasCallStack) => a
todo :: forall a. HasCallStack => a
todo = SomeException -> a
forall a b. a -> b
raise# (String -> CallStack -> SomeException
errorCallWithCallStackException String
"Prelude.todo: not yet implemented" HasCallStack
CallStack
?callStack)
{-# WARNING todo "todo remains in code" #-}

{- ORMOLU_DISABLE -}

-- | TODO: We have a weird error on OSX that is caused by the CPP in
-- app/Main.hs:
--
--      error: non-portable path to file '".stack-work/dist/aarch64-osx/ghc-9.8.2/build/Shrun/autogen/cabal_macros.h"'; specified path differs in case from file name on disk [-Werror,-Wnonportable-include-path]
--     #include ".stack-work/dist/aarch64-osx/ghc-9.8.2/build/shrun/autogen/cabal_macros.h"
--     ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--     ".stack-work/dist/aarch64-osx/ghc-9.8.2/build/Shrun/autogen/cabal_macros.h"
--
-- There are multiple solutions:
--
-- 1. Attempt to disable -Wnonportable-include-path
--    (see also https://github.com/IHaskell/IHaskell/issues/942).
--
-- 2. Move the CPP here (seems fine here (maybe because it's not an exe?)).
--
-- In any case, once we move completely to GHC 9.10+, we can remove this
-- branch.
setUncaughtExceptionHandlerDisplay :: IO ()
setUncaughtExceptionHandlerDisplay :: IO ()
setUncaughtExceptionHandlerDisplay =
  (SomeException -> IO ()) -> IO ()
forall (m :: Type -> Type).
(MonadGlobalException m, HasCallStack) =>
(SomeException -> m ()) -> m ()
Ex.setUncaughtExceptionHandler SomeException -> IO ()
forall {f :: Type -> Type}.
MonadTerminal f =>
SomeException -> f ()
printExceptExitCode
  where
#if MIN_VERSION_base(4, 20, 0)
    printExceptExitCode ex = case fromException ex of
      Just ExitSuccess -> pure ()
      -- for command failures
      Just (ExitFailure _) -> pure ()
      Nothing -> putStrLn $ displayException ex
#else
    printExceptExitCode :: SomeException -> f ()
printExceptExitCode SomeException
ex = case SomeException -> Maybe (ExceptionCS ExitCode)
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex of
      Just (Ex.MkExceptionCS ExitCode
ExitSuccess CallStack
_) -> () -> f ()
forall a. a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
      -- for command failures
      Just (Ex.MkExceptionCS (ExitFailure Int
_) CallStack
_) -> () -> f ()
forall a. a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
      Maybe (ExceptionCS ExitCode)
Nothing -> String -> f ()
forall (m :: Type -> Type).
(MonadTerminal m, HasCallStack) =>
String -> m ()
putStrLn (String -> f ()) -> String -> f ()
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
ex
#endif

{- ORMOLU_ENABLE -}