{-# 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,

    -- * Optparse
    DocOA,

    -- * Fold utils
    foldMapA,

    -- * Pretty printing
    PrettySwitch (..),
    indentField,
    prettyBytesFloat,
    prettyBytesInt,
    prettyMaybe,
    prettyToText,

    -- * Misc utilities
    Result (..),
    fromFoldable,
    onJust,
    (<<$>>),
    (<<&>>),
    convertIntegral,
    unsafeConvertIntegral,
    catSeqMaybes,
    neToList,
    listToSeq,
    neseqToSeq,
    unsafeListToNE,
    unsafeListToNESeq,

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

#if !MIN_VERSION_base(4, 20, 0)

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

#endif

    -- * Debug Utils
    todo,
    traceFile,
    traceFileA,
    traceFileLine,
    traceFileLineA,

    -- * Exceptions
    TermException (..),
    tryMySync,
    tryMySync_,
    onMyAsync,
    isMyAsync,
    isTermException,

    -- * Prelude exports
    module X,
  )
where

{- ORMOLU_ENABLE -}

import Control.Applicative as X
  ( Alternative (empty, many, some, (<|>)),
    Applicative (liftA2, pure, (*>), (<*), (<*>)),
    asum,
    (<**>),
  )
import Control.Category as X (Category ((.)), (<<<), (>>>))
import Control.Concurrent as X (threadDelay)
import Control.Concurrent qualified as CC
import Control.Concurrent.STM as X (STM)
import Control.Concurrent.STM.TMVar as X (TMVar, newTMVar)
import Control.DeepSeq as X (NFData, force)
import Control.Exception as X
  ( Exception (displayException, fromException, toException),
    SomeException,
  )
import Control.Exception.Utils as X
  ( StringException (MkStringException),
    exitFailure,
    throwString,
    throwText,
  )
import Control.Exception.Utils qualified as Ex.Utils
import Control.Monad as X
  ( Monad ((>>=)),
    forever,
    join,
    unless,
    void,
    when,
    (<=<),
    (=<<),
    (>=>),
  )
import Control.Monad.Catch as X
  ( MonadCatch,
    MonadMask,
    MonadThrow,
    bracket,
    bracket_,
    catch,
    finally,
    mask,
    onException,
    throwM,
    try,
  )
import Control.Monad.Catch.Pure qualified as C
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 (bimap, first, second))
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),
    FloatingFormatter,
    Fromℤ,
    Size (B),
    Sized,
    _MkBytes,
  )
import Data.Bytes qualified as Bytes
import Data.Bytes.Formatting (IntegralFormatter)
import Data.Bytes.Formatting qualified as BytesFmt
import Data.Bytes.Formatting.Base (BaseFormatter, Formatter)
import Data.Char as X (Char)
import Data.Coerce as X (coerce)
import Data.Either as X (Either (Left, Right))
import Data.Eq as X (Eq ((/=), (==)))
import Data.Foldable as X
  ( Foldable (fold, foldMap, foldl', foldr, toList),
    any,
    for_,
    length,
    traverse_,
  )
import Data.Foldable1 as X (Foldable1, fold1, foldMap1, foldr1)
import Data.Function as X (const, flip, id, ($), (&))
import Data.Functor as X
  ( Functor (fmap),
    ($>),
    (<$),
    (<$>),
    (<&>),
  )
import Data.HashMap.Strict as X (HashMap)
import Data.HashSet as X (HashSet)
import Data.Hashable as X (Hashable (hashWithSalt))
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.List.NonEmpty qualified as NE
import Data.Map.Strict as X (Map)
import Data.Maybe as X (Maybe (Just, Nothing), fromMaybe, maybe)
import Data.Monoid as X (Ap (Ap, getAp), Monoid (mconcat, mempty))
import Data.Ord as X (Ord ((<), (<=), (>), (>=)), Ordering)
import Data.Proxy as X (Proxy (Proxy))
import Data.Semigroup as X (Semigroup (sconcat, (<>)))
import Data.Sequence as X (Seq ((:<|), (:|>)), pattern Empty)
import Data.Sequence qualified as Seq
import Data.Sequence.NonEmpty as X (NESeq ((:<||), (:||>)), pattern IsEmpty)
import Data.Sequence.NonEmpty qualified as NESeq
import Data.Singletons (SingI)
import Data.String as X (IsString (fromString), String)
import Data.Text as X (Text, pack, unpack)
import Data.Text qualified as T
import Data.Traversable as X (Traversable (sequenceA, traverse), for)
import Data.Tuple as X (fst, snd, uncurry)
#if MIN_VERSION_base(4, 20, 0)
import Data.Tuple.Experimental as X (Tuple2, Tuple3, Tuple4, Tuple5)
#endif
import Data.Text.Display as X (Display, display)
import Data.Type.Equality as X (type (~))
import Data.Void as X (Void, absurd)
import Data.Word as X (Word16)
import Effects.Concurrent.Async as X (MonadAsync)
import Effects.Concurrent.STM as X
  ( MonadAtomic (atomically),
    TBQueue,
    TVar,
    flushTBQueueA',
    modifyTVarA',
    newTBQueue,
    newTBQueueA,
    newTVar',
    newTVarA',
    readTBQueueA',
    readTVar',
    readTVarA',
    tryReadTBQueueA',
    writeTBQueue',
    writeTBQueueA',
    writeTVar',
    writeTVarA',
  )
import Effects.Concurrent.Thread as X
  ( MVar,
    MonadMVar (newMVar', putMVar', tryTakeMVar'),
    MonadThread,
    microsleep,
    sleep,
  )
import Effects.Evaluate as X (MonadEvaluate (evaluate))
import Effects.FileSystem.FileReader as X
  ( MonadFileReader,
    decodeUtf8Lenient,
    readFileUtf8Lenient,
    readFileUtf8ThrowM,
  )
import Effects.FileSystem.FileWriter as X
  ( MonadFileWriter,
    appendFileUtf8,
    writeFileUtf8,
  )
import Effects.FileSystem.Handle as X
  ( CanRead,
    CanWrite,
    Handle,
    HandleMode (HandleModeRead, HandleModeReadWrite, HandleModeWrite),
    HandleR,
    HandleRW,
    HandleW,
    LockedHandleR,
    LockedHandleRW,
    LockedHandleW,
  )
import Effects.FileSystem.HandleReader as X (MonadHandleReader)
import Effects.FileSystem.HandleWriter as X
  ( LockedHandle,
    MonadHandleWriter (hClose, hFlush, openBinaryFile),
    hPutUtf8,
    liftLocked,
    withLockedFile,
  )
import Effects.FileSystem.PathReader as X
  ( MonadPathReader (doesDirectoryExist, doesFileExist, getFileSize),
    getXdgConfig,
    getXdgState,
  )
import Effects.FileSystem.PathWriter as X
  ( MonadPathWriter,
    removeDirectoryIfExists,
    removeFile,
    removeFileIfExists,
    removeFileIfExists_,
  )
import Effects.IORef as X
  ( IORef,
    MonadIORef
      ( atomicModifyIORef',
        modifyIORef',
        newIORef',
        readIORef',
        writeIORef'
      ),
  )
import Effects.Notify as X
  ( MonadNotify (NotifyEnvF, initNotifyEnv, notify),
    Note,
    NotifyEnv,
    NotifyParseException,
    NotifySystem
      ( NotifySystemAppleScript,
        NotifySystemDBus,
        NotifySystemNotifySend,
        NotifySystemWindows
      ),
    NotifySystemOs,
    NotifyTimeout (NotifyTimeoutMillis, NotifyTimeoutNever),
    NotifyUrgency
      ( NotifyUrgencyCritical,
        NotifyUrgencyLow,
        NotifyUrgencyNormal
      ),
    defaultNotifySystem,
    defaultNotifySystemOs,
    notifySystemToOs,
  )
import Effects.Optparse as X (MonadOptparse (customExecParser, execParser))
import Effects.System.Environment as X (MonadEnv (withArgs))
import Effects.System.Posix.Files as X (MonadPosixFiles)
import Effects.System.Posix.Signals as X (MonadPosixSignals)
import Effects.System.Process as X (CreateProcess, MonadProcess)
import Effects.System.Terminal as X
  ( MonadTerminal,
    Window (Window),
    getTerminalSize,
    putStr,
    putStrLn,
    putText,
    putTextLn,
  )
import Effects.Time as X (MonadTime, withTiming)
import FileSystem.OsPath as X
  ( OsPath,
    decodeLenient,
    decodeThrowM,
    encodeThrowM,
    osp,
    ospPathSep,
    unsafeEncode,
    (</>),
  )
import FileSystem.OsPath qualified as OsPath
import FileSystem.UTF8 as X (decodeUtf8, decodeUtf8ThrowM)
import GHC.Enum as X (Bounded (maxBound, minBound), Enum (fromEnum, 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, div, truncate)
import GHC.Show as X (Show (show, showsPrec))
import GHC.Stack as X (HasCallStack, withFrozenCallStack)
import Numeric.Algebra (MGroup)
import Numeric.Algebra as X
  ( ASemigroup ((.+.)),
    MMonoid (one),
    MSemigroup,
    Normed,
  )
import Numeric.Convert.Integer as X
  ( FromInteger (fromZ),
    ToInteger (toZ),
    fromℤ,
    toℤ,
  )
import Numeric.Data.NonNegative as X
  ( NonNegative (MkNonNegative),
    mkNonNegative,
    unsafeNonNegative,
  )
import Numeric.Data.Positive as X
  ( Positive (MkPositive),
    mkPositive,
    unsafePositive,
  )
import Optics.Core as X
  ( A_Getter,
    A_Lens,
    A_Prism,
    A_Setter,
    AffineFold,
    AffineTraversal',
    An_AffineFold,
    An_AffineTraversal,
    An_Iso,
    Getter,
    Is,
    Iso',
    LabelOptic (labelOptic),
    Lens,
    Lens',
    NoIx,
    Optic,
    Optic',
    Prism,
    Prism',
    afolding,
    iso,
    lensVL,
    over',
    preview,
    prism,
    review,
    set',
    to,
    view,
    (#),
    (%),
    (%!~),
    (%?),
    (.~),
    (?~),
    (^.),
    (^?),
    _1,
    _2,
    _3,
    _Just,
    _Left,
    _Nothing,
    _Right,
  )
import Optics.Core.Extras as X (is)
import Options.Applicative.Help qualified as H
import Prettyprinter as X
  ( Doc,
    Pretty (pretty),
    comma,
    hsep,
    indent,
    nest,
    punctuate,
    vcat,
  )
import Prettyprinter qualified
import Prettyprinter.Render.Text qualified as PrettyprinterT
import Shrun.Data.Result as X
import System.Console.Regions as X (ConsoleRegion, RegionLayout (Linear))
import System.Exit as X (ExitCode (ExitFailure, ExitSuccess))
import System.IO as X (FilePath, IO, IOMode (AppendMode, WriteMode), print)
import System.IO.Unsafe (unsafePerformIO)
import TOML as X
  ( DecodeTOML (tomlDecoder),
    Decoder,
    TOMLError,
    Value,
    decode,
    decodeWith,
    getArrayOf,
    getField,
    getFieldOpt,
    getFieldOptWith,
    getFieldWith,
    invalidValue,
    makeDecoder,
    renderTOMLError,
    runDecoder,
    typeMismatch,
  )
import Text.Printf (PrintfArg)
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
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f a -> Maybe a
forall (f :: Type -> Type) a. Foldable f => f a -> Maybe a
headMaybe
{-# INLINEABLE fromFoldable #-}

-- | 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
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 <<$>>

{-# INLINE (<<$>>) #-}

-- | 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)
(<<$>>)
{-# INLINE (<<&>>) #-}

#if !MIN_VERSION_base(4, 20, 0)

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

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

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

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

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

#endif

neToList :: NonEmpty a -> List a
neToList :: forall a. NonEmpty a -> [a]
neToList = NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.toList

neseqToSeq :: NESeq a -> Seq a
neseqToSeq :: forall a. NESeq a -> Seq a
neseqToSeq = NESeq a -> Seq a
forall a. NESeq a -> Seq a
NESeq.toSeq

unsafeListToNE :: (HasCallStack) => List a -> NonEmpty a
unsafeListToNE :: forall a. HasCallStack => [a] -> NonEmpty a
unsafeListToNE = [a] -> NonEmpty a
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList

unsafeListToNESeq :: (HasCallStack) => List a -> NESeq a
unsafeListToNESeq :: forall a. HasCallStack => [a] -> NESeq a
unsafeListToNESeq = NonEmpty a -> NESeq a
forall a. NonEmpty a -> NESeq a
NESeq.fromList (NonEmpty a -> NESeq a) -> ([a] -> NonEmpty a) -> [a] -> NESeq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [a] -> NonEmpty a
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList

listToSeq :: List a -> Seq a
listToSeq :: forall a. [a] -> Seq a
listToSeq = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList

-- | 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 -> Either String b
forall a b.
(Bits a, Bits b, Integral a, Integral b, Show a, Typeable a,
 Typeable b) =>
a -> Either String b
convertIntegral a
x of
  Right b
y -> b
y
  Left String
err -> String -> b
forall a. HasCallStack => String -> a
error String
err

-- | Like 'fromIntegral', except the conversion is only between integral types.
convertIntegral ::
  forall a b.
  ( Bits a,
    Bits b,
    Integral a,
    Integral b,
    Show a,
    Typeable a,
    Typeable b
  ) =>
  a ->
  Either String b
convertIntegral :: forall a b.
(Bits a, Bits b, Integral a, Integral b, Show a, Typeable a,
 Typeable b) =>
a -> Either String b
convertIntegral 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 -> Either String b
forall a b. b -> Either a b
Right b
y
  Maybe b
Nothing ->
    String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either 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" #-}

traceSem :: CC.QSem
traceSem :: QSem
traceSem = IO QSem -> QSem
forall a. IO a -> a
unsafePerformIO (Int -> IO QSem
CC.newQSem Int
1)
{-# NOINLINE traceSem #-}

traceFile :: FilePath -> Text -> a -> a
traceFile :: forall a. String -> Text -> a -> a
traceFile String
path Text
txt a
x = ()
writeFn () -> a -> a
forall a b. a -> b -> b
`seq` a
x
  where
    io :: IO ()
io = OsPath -> Text -> IO ()
forall (m :: Type -> Type).
(HasCallStack, MonadFileWriter m) =>
OsPath -> Text -> m ()
appendFileUtf8 (HasCallStack => String -> OsPath
String -> OsPath
OsPath.unsafeEncode String
path) Text
txt

    -- Guard writes behind a mutex. This is technically overkill for different
    -- files, but it is in fact necessary when we have multiple threads
    -- writing to the same file. E.g. if I run
    --
    --   TEST_FUNCTIONAL=1 cabal run shrun -- "cabal test functional"
    --
    -- Then tests will randomly die with a shrun error "Encountered an
    -- exception ...". With the mutex, these errors disappear. Hence we use
    -- this as it appears to be strictly helpful when debugging.
    writeFn :: ()
writeFn =
      IO () -> ()
forall a. IO a -> a
unsafePerformIO
        (IO () -> ()) -> (IO () -> IO ()) -> IO () -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO () -> IO () -> IO () -> IO ()
forall (m :: Type -> Type) a c b.
(HasCallStack, MonadMask m) =>
m a -> m c -> m b -> m b
bracket_ (QSem -> IO ()
CC.waitQSem QSem
traceSem) (QSem -> IO ()
CC.signalQSem QSem
traceSem)
        (IO () -> ()) -> IO () -> ()
forall a b. (a -> b) -> a -> b
$ IO ()
io

traceFileA :: (Applicative f) => FilePath -> Text -> f ()
traceFileA :: forall (f :: Type -> Type). Applicative f => String -> Text -> f ()
traceFileA String
f Text
t = String -> Text -> f () -> f ()
forall a. String -> Text -> a -> a
traceFile String
f Text
t (() -> f ()
forall a. a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ())

traceFileLine :: FilePath -> Text -> a -> a
traceFileLine :: forall a. String -> Text -> a -> a
traceFileLine String
path Text
txt = String -> Text -> a -> a
forall a. String -> Text -> a -> a
traceFile String
path (Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")

traceFileLineA :: (Applicative f) => FilePath -> Text -> f ()
traceFileLineA :: forall (f :: Type -> Type). Applicative f => String -> Text -> f ()
traceFileLineA String
f Text
t = String -> Text -> f () -> f ()
forall a. String -> Text -> a -> a
traceFileLine String
f Text
t (() -> f ()
forall a. a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ())

onJust :: b -> Maybe a -> (a -> b) -> b
onJust :: forall b a. b -> Maybe a -> (a -> b) -> b
onJust b
x Maybe a
m a -> b
f = b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
x a -> b
f Maybe a
m

-- | TermException is explicitly for when the current process is cancelled
-- (SIGTERM on posix). We use a separate type so that we can distinguish it
-- from potentially other ThreadKilleds that might be sent (e.g. bugs).
data TermException = MkTermException
  deriving stock (Int -> TermException -> ShowS
[TermException] -> ShowS
TermException -> String
(Int -> TermException -> ShowS)
-> (TermException -> String)
-> ([TermException] -> ShowS)
-> Show TermException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TermException -> ShowS
showsPrec :: Int -> TermException -> ShowS
$cshow :: TermException -> String
show :: TermException -> String
$cshowList :: [TermException] -> ShowS
showList :: [TermException] -> ShowS
Show)

instance Exception TermException where
  displayException :: TermException -> String
displayException TermException
_ = String
"Received terminated signal"

-- We want our TermException to be considered Async for the purposes of our
-- handlers since it morally is (spawned by an outside signal). Hence
-- these should be used over the usual trySync, thus always in scope.
tryMySync :: (HasCallStack, MonadCatch m) => m a -> m (Either SomeException a)
tryMySync :: forall (m :: Type -> Type) a.
(HasCallStack, MonadCatch m) =>
m a -> m (Either SomeException a)
tryMySync = (SomeException -> Bool) -> m a -> m (Either SomeException a)
forall (m :: Type -> Type) e a.
(Exception e, HasCallStack, MonadCatch m) =>
(e -> Bool) -> m a -> m (Either e a)
Ex.Utils.tryIf (Bool -> Bool
not (Bool -> Bool) -> (SomeException -> Bool) -> SomeException -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SomeException -> Bool
forall e. Exception e => e -> Bool
isMyAsync)

tryMySync_ :: (HasCallStack, MonadCatch m) => m a -> m ()
tryMySync_ :: forall (m :: Type -> Type) a.
(HasCallStack, MonadCatch m) =>
m a -> m ()
tryMySync_ = m (Either SomeException a) -> m ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (m (Either SomeException a) -> m ())
-> (m a -> m (Either SomeException a)) -> m a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m a -> m (Either SomeException a)
forall (m :: Type -> Type) a.
(HasCallStack, MonadCatch m) =>
m a -> m (Either SomeException a)
tryMySync

onMyAsync :: (HasCallStack, MonadCatch m) => m a -> m b -> m a
onMyAsync :: forall (m :: Type -> Type) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
onMyAsync m a
action m b
handler = (HasCallStack => m a -> (SomeException -> m a) -> m a)
-> m a -> (SomeException -> m a) -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack m a -> (SomeException -> m a) -> m a
HasCallStack => m a -> (SomeException -> m a) -> m a
forall {a}. m a -> (SomeException -> m a) -> m a
catchAsync m a
action ((SomeException -> m a) -> m a) -> (SomeException -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \SomeException
e -> do
  m (Either SomeException b) -> m ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (m (Either SomeException b) -> m ())
-> m (Either SomeException b) -> m ()
forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try @_ @SomeException m b
handler
  SomeException -> m a
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: Type -> Type) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM SomeException
e
  where
    catchAsync :: m a -> (SomeException -> m a) -> m a
catchAsync = forall (m :: Type -> Type) e a.
(Exception e, HasCallStack, MonadCatch m) =>
(e -> Bool) -> m a -> (e -> m a) -> m a
Ex.Utils.catchIf @_ @SomeException SomeException -> Bool
forall e. Exception e => e -> Bool
isMyAsync

isMyAsync :: (Exception e) => e -> Bool
isMyAsync :: forall e. Exception e => e -> Bool
isMyAsync e
e = e -> Bool
forall e. Exception e => e -> Bool
Ex.Utils.isAsyncException e
e Bool -> Bool -> Bool
|| e -> Bool
forall e. Exception e => e -> Bool
isTermException e
e

isTermException :: (Exception e) => e -> Bool
isTermException :: forall e. Exception e => e -> Bool
isTermException e
e = case SomeException -> Maybe TermException
forall e. Exception e => SomeException -> Maybe e
fromException (e -> SomeException
forall e. Exception e => e -> SomeException
toException e
e) of
  Just TermException
MkTermException -> Bool
True
  Maybe TermException
Nothing -> Bool
False

catSeqMaybes :: Seq (Maybe a) -> Seq a
catSeqMaybes :: forall a. Seq (Maybe a) -> Seq a
catSeqMaybes = (Seq a -> Maybe a -> Seq a) -> Seq a -> Seq (Maybe a) -> Seq a
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Seq a -> Maybe a -> Seq a
forall {a}. Seq a -> Maybe a -> Seq a
go Seq a
forall a. Seq a
Empty
  where
    go :: Seq a -> Maybe a -> Seq a
go Seq a
acc Maybe a
Nothing = Seq a
acc
    go Seq a
acc (Just a
x) = Seq a
acc Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
:|> a
x

-- | Alias for optparse's Doc, so we do not clash with prettyprinter's Doc.
-- The former is an alias for the latter's Doc AnsiStyle.
type DocOA = H.Doc

newtype PrettySwitch = MkPrettySwitch Bool

instance Pretty PrettySwitch where
  pretty :: forall ann. PrettySwitch -> Doc ann
pretty = \case
    MkPrettySwitch Bool
True -> Doc ann
"on"
    MkPrettySwitch Bool
False -> Doc ann
"off"

indentField :: Doc ann -> Doc ann
indentField :: forall ann. Doc ann -> Doc ann
indentField = Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2

prettyBytesFloat ::
  ( BaseFormatter a ~ FloatingFormatter,
    Fromℤ a,
    MGroup a,
    Normed a,
    Ord a,
    PrintfArg a,
    SingI s
  ) =>
  Bytes s a ->
  Doc ann
prettyBytesFloat :: forall a (s :: Size) ann.
(BaseFormatter a ~ FloatingFormatter, Fromℤ a, MGroup a, Normed a,
 Ord a, PrintfArg a, SingI s) =>
Bytes s a -> Doc ann
prettyBytesFloat = FloatingFormatter -> Bytes s a -> Doc ann
forall a fmt (s :: Size) ann.
(BaseFormatter a ~ fmt, Fromℤ a, Formatter fmt, MGroup a, Normed a,
 Ord a, PrintfArg a, SingI s) =>
fmt -> Bytes s a -> Doc ann
prettyBytes (Maybe Word8 -> FloatingFormatter
BytesFmt.MkFloatingFormatter (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
2))

prettyBytesInt ::
  ( BaseFormatter a ~ IntegralFormatter,
    Fromℤ a,
    MGroup a,
    Normed a,
    Ord a,
    PrintfArg a,
    SingI s
  ) =>
  Bytes s a ->
  Doc ann
prettyBytesInt :: forall a (s :: Size) ann.
(BaseFormatter a ~ IntegralFormatter, Fromℤ a, MGroup a, Normed a,
 Ord a, PrintfArg a, SingI s) =>
Bytes s a -> Doc ann
prettyBytesInt = IntegralFormatter -> Bytes s a -> Doc ann
forall a fmt (s :: Size) ann.
(BaseFormatter a ~ fmt, Fromℤ a, Formatter fmt, MGroup a, Normed a,
 Ord a, PrintfArg a, SingI s) =>
fmt -> Bytes s a -> Doc ann
prettyBytes IntegralFormatter
BytesFmt.MkIntegralFormatter

prettyBytes ::
  ( BaseFormatter a ~ fmt,
    Fromℤ a,
    Formatter fmt,
    MGroup a,
    Normed a,
    Ord a,
    PrintfArg a,
    SingI s
  ) =>
  fmt ->
  Bytes s a ->
  Doc ann
prettyBytes :: forall a fmt (s :: Size) ann.
(BaseFormatter a ~ fmt, Fromℤ a, Formatter fmt, MGroup a, Normed a,
 Ord a, PrintfArg a, SingI s) =>
fmt -> Bytes s a -> Doc ann
prettyBytes fmt
fmt =
  Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty
    (Text -> Doc ann) -> (Bytes s a -> Text) -> Bytes s a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BaseFormatter (Raw (SomeSize a))
-> SizedFormatter -> SomeSize a -> Text
forall a.
(Formatter (BaseFormatter (Raw a)), PrintfArg (Raw a),
 RawNumeric a, Sized a) =>
BaseFormatter (Raw a) -> SizedFormatter -> a -> Text
BytesFmt.formatSized fmt
BaseFormatter (Raw (SomeSize a))
fmt SizedFormatter
BytesFmt.sizedFormatterNatural
    (SomeSize a -> Text)
-> (Bytes s a -> SomeSize a) -> Bytes s a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Bytes s a -> Norm (Bytes s a)
Bytes s a -> SomeSize a
forall a. Normalize a => a -> Norm a
Bytes.normalize

prettyMaybe :: (Pretty a) => Maybe a -> Doc ann
prettyMaybe :: forall a ann. Pretty a => Maybe a -> Doc ann
prettyMaybe Maybe a
Nothing = Doc ann
"off"
prettyMaybe (Just a
x) = a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
x

prettyToText :: (Pretty a) => a -> Text
prettyToText :: forall a. Pretty a => a -> Text
prettyToText =
  SimpleDocStream (ZonkAny 0) -> Text
forall ann. SimpleDocStream ann -> Text
PrettyprinterT.renderStrict
    (SimpleDocStream (ZonkAny 0) -> Text)
-> (a -> SimpleDocStream (ZonkAny 0)) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LayoutOptions -> Doc (ZonkAny 0) -> SimpleDocStream (ZonkAny 0)
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
Prettyprinter.layoutPretty LayoutOptions
Prettyprinter.defaultLayoutOptions
    (Doc (ZonkAny 0) -> SimpleDocStream (ZonkAny 0))
-> (a -> Doc (ZonkAny 0)) -> a -> SimpleDocStream (ZonkAny 0)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Doc (ZonkAny 0)
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty

foldMapA :: (Applicative m, Foldable t, Monoid b) => (a -> m b) -> t a -> m b
foldMapA :: forall (m :: Type -> Type) (t :: Type -> Type) b a.
(Applicative m, Foldable t, Monoid b) =>
(a -> m b) -> t a -> m b
foldMapA a -> m b
f = Ap m b -> m b
forall {k} (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (Ap m b -> m b) -> (t a -> Ap m b) -> t a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Ap m b) -> t a -> Ap m b
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (m b -> Ap m b
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (m b -> Ap m b) -> (a -> m b) -> a -> Ap m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> m b
f)