    {-# LANGUAGE ScopedTypeVariables, ConstraintKinds, GeneralizedNewtypeDeriving, ViewPatterns #-}
    {-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-}

    module General.Extra(
        getProcessorCount,
        findGcc,
        whenLeft,
        randomElem,
        wrapQuote, showBracket,
        withs, forNothingM,
        maximum', maximumBy',
        unconcat,
        fastAt,
        headErr, tailErr,
        zipExact, zipWithExact,
        isAsyncException,
        showDurationSecs,
        usingLineBuffering,
        doesFileExist_, doesDirectoryExist_,
        usingNumCapabilities,
        removeFile_, createDirectoryRecursive,
        catchIO, tryIO, handleIO, handleSynchronous,
        Located, Partial, callStackTop, callStackFull, withFrozenCallStack, callStackFromException,
        Ver(..), makeVer,
        QTypeRep(..),
        NoShow(..)
        ) where

    import Control.Exception.Extra
    import Data.Char
    import Data.List.Extra
    import System.Environment
    import Development.Shake.FilePath
    import Control.DeepSeq
    import General.Cleanup
    import Data.Typeable
    import System.IO.Error
    import System.IO.Extra
    import System.Time.Extra
    import System.IO.Unsafe
    import System.Info.Extra
    import System.Random
    import System.Directory
    import System.Exit
    import Numeric.Extra
    import Foreign.Storable
    import Control.Concurrent.Extra
    import Data.Maybe
    import Data.Hashable
    import Data.Primitive.Array
    import Control.Monad
    import Control.Monad.ST
    import GHC.Conc(getNumProcessors)
    import GHC.Stack

    ---------------------------------------------------------------------
    -- Prelude

    -- See https://ghc.haskell.org/trac/ghc/ticket/10830 - they broke maximumBy
    maximumBy' :: (a -> a -> Ordering) -> [a] -> a
    maximumBy' :: forall a. (a -> a -> Ordering) -> [a] -> a
    maximumBy' a -> a -> Ordering
    cmp = (a -> a -> a) -> [a] -> a
    forall a. HasCallStack => (a -> a -> a) -> [a] -> a
    foldl1' ((a -> a -> a) -> [a] -> a) -> (a -> a -> a) -> [a] -> a
    forall a b. (a -> b) -> a -> b
    $ \a
    x a
    y -> if a -> a -> Ordering
    cmp a
    x a
    y Ordering -> Ordering -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ordering
    GT then a
    x else a
    y

    maximum' :: Ord a => [a] -> a
    maximum' :: forall a. Ord a => [a] -> a
    maximum' = (a -> a -> Ordering) -> [a] -> a
    forall a. (a -> a -> Ordering) -> [a] -> a
    maximumBy' a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare

    newtype NoShow a = NoShow a
    instance Show (NoShow a) where show :: NoShow a -> String
    show NoShow a
    _ = String
    "NoShow"

    unconcat :: [[a]] -> [b] -> [[b]]
    unconcat :: forall a b. [[a]] -> [b] -> [[b]]
    unconcat [] [b]
    _ = []
    unconcat ([a]
    a:[[a]]
    as) [b]
    bs = [b]
    b1 [b] -> [[b]] -> [[b]]
    forall a. a -> [a] -> [a]
    : [[a]] -> [b] -> [[b]]
    forall a b. [[a]] -> [b] -> [[b]]
    unconcat [[a]]
    as [b]
    b2
        where ([b]
    b1,[b]
    b2) = Int -> [b] -> ([b], [b])
    forall a. Int -> [a] -> ([a], [a])
    splitAt ([a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    a) [b]
    bs

    headErr :: [a] -> a
    headErr :: forall a. [a] -> a
    headErr = [a] -> a
    forall a. HasCallStack => [a] -> a
    head

    tailErr :: [a] -> [a]
    tailErr :: forall a. [a] -> [a]
    tailErr = [a] -> [a]
    forall a. HasCallStack => [a] -> [a]
    tail

    ---------------------------------------------------------------------
    -- Data.List

    -- | If a string has any spaces then put quotes around and double up all internal quotes.
    --   Roughly the inverse of Windows command line parsing.
    wrapQuote :: String -> String
    wrapQuote :: ShowS
    wrapQuote String
    xs | (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Char -> Bool
    isSpace String
    xs = String
    "\"" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (Char -> String) -> ShowS
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\Char
    x -> if Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\"' then String
    "\"\"" else [Char
    x]) String
    xs String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\""
                 | Bool
    otherwise = String
    xs

    -- | If a string has any spaces then put brackets around it.
    wrapBracket :: String -> String
    wrapBracket :: ShowS
    wrapBracket String
    xs | (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Char -> Bool
    isSpace String
    xs = String
    "(" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    xs String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
                   | Bool
    otherwise = String
    xs

    -- | Alias for @wrapBracket . show@.
    showBracket :: Show a => a -> String
    showBracket :: forall a. Show a => a -> String
    showBracket = ShowS
    wrapBracket ShowS -> (a -> String) -> a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    forall a. Show a => a -> String
    show

    -- | Version of '!!' which is fast and returns 'Nothing' if the index is not present.
    fastAt :: [a] -> (Int -> Maybe a)
    fastAt :: forall a. [a] -> Int -> Maybe a
    fastAt [a]
    xs = \Int
    i -> if Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 Bool -> Bool -> Bool
    || Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    n then Maybe a
    forall a. Maybe a
    Nothing else a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> a -> Maybe a
    forall a b. (a -> b) -> a -> b
    $ Array a -> Int -> a
    forall a. Array a -> Int -> a
    indexArray Array a
    arr Int
    i
        where
            n :: Int
    n = [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    xs
            arr :: Array a
    arr = (forall s. ST s (Array a)) -> Array a
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (Array a)) -> Array a)
    -> (forall s. ST s (Array a)) -> Array a
    forall a b. (a -> b) -> a -> b
    $ do
                let n :: Int
    n = [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    xs
                arr <- Int -> a -> ST s (MutableArray (PrimState (ST s)) a)
    forall (m :: * -> *) a.
    PrimMonad m =>
    Int -> a -> m (MutableArray (PrimState m) a)
    newArray Int
    n a
    forall a. HasCallStack => a
    undefined
                forM_ (zipFrom 0 xs) $ \(Int
    i,a
    x) ->
                    MutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
    forall (m :: * -> *) a.
    PrimMonad m =>
    MutableArray (PrimState m) a -> Int -> a -> m ()
    writeArray MutableArray s a
    MutableArray (PrimState (ST s)) a
    arr Int
    i a
    x
                unsafeFreezeArray arr

    zipWithExact :: Partial => (a -> b -> c) -> [a] -> [b] -> [c]
    zipWithExact :: forall a b c. HasCallStack => (a -> b -> c) -> [a] -> [b] -> [c]
    zipWithExact a -> b -> c
    f = [a] -> [b] -> [c]
    g
        where
            g :: [a] -> [b] -> [c]
    g [] [] = []
            g (a
    a:[a]
    as) (b
    b:[b]
    bs) = a -> b -> c
    f a
    a b
    b c -> [c] -> [c]
    forall a. a -> [a] -> [a]
    : [a] -> [b] -> [c]
    g [a]
    as [b]
    bs
            g [a]
    _ [b]
    _ = String -> [c]
    forall a. HasCallStack => String -> a
    error String
    "zipWithExacts: unequal lengths"

    zipExact :: Partial => [a] -> [b] -> [(a,b)]
    zipExact :: forall a b. HasCallStack => [a] -> [b] -> [(a, b)]
    zipExact = (a -> b -> (a, b)) -> [a] -> [b] -> [(a, b)]
    forall a b c. HasCallStack => (a -> b -> c) -> [a] -> [b] -> [c]
    zipWithExact (,)

    ---------------------------------------------------------------------
    -- System.Info

    {-# NOINLINE getProcessorCount #-}
    getProcessorCount :: IO Int
    -- unsafePefromIO so we cache the result and only compute it once
    getProcessorCount :: IO Int
    getProcessorCount = let res :: Int
    res = IO Int -> Int
    forall a. IO a -> a
    unsafePerformIO IO Int
    act in Int -> IO Int
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    res
        where
            act :: IO Int
    act =
                if Bool
    rtsSupportsBoundThreads then
                    Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Int) -> IO Int -> IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO Int
    getNumProcessors
                else do
                    env <- String -> IO (Maybe String)
    lookupEnv String
    "NUMBER_OF_PROCESSORS"
                    case env of
                        Just String
    s | [(Int
    i,String
    "")] <- ReadS Int
    forall a. Read a => ReadS a
    reads String
    s -> Int -> IO Int
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    i
                        Maybe String
    _ -> do
                            src <- String -> IO String
    readFile' String
    "/proc/cpuinfo" IO String -> (IOException -> IO String) -> IO String
    forall a. IO a -> (IOException -> IO a) -> IO a
    `catchIO` \IOException
    _ -> String -> IO String
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure String
    ""
                            pure $! max 1 $ length [() | x <- lines src, "processor" `isPrefixOf` x]

    -- Can you find a GCC executable? return a Bool, and optionally something to add to $PATH to run it
    findGcc :: IO (Bool, Maybe FilePath)
    findGcc :: IO (Bool, Maybe String)
    findGcc = do
        v <- String -> IO (Maybe String)
    findExecutable String
    "gcc"
        case v of
            Maybe String
    Nothing | Bool
    isWindows -> do
                ghc <- String -> IO (Maybe String)
    findExecutable String
    "ghc"
                case ghc of
                    Just String
    ghc -> do
                        let gcc :: String
    gcc = ShowS
    takeDirectory (ShowS
    takeDirectory String
    ghc) String -> ShowS
    </> String
    "mingw/bin/gcc.exe"
                        b <- String -> IO Bool
    doesFileExist_ String
    gcc
                        pure $ if b then (True, Just $ takeDirectory gcc) else (False, Nothing)
                    Maybe String
    _ -> (Bool, Maybe String) -> IO (Bool, Maybe String)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Bool
    False, Maybe String
    forall a. Maybe a
    Nothing)
            Maybe String
    _ -> (Bool, Maybe String) -> IO (Bool, Maybe String)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe String
    v, Maybe String
    forall a. Maybe a
    Nothing)

    ---------------------------------------------------------------------
    -- System.Random

    randomElem :: [a] -> IO a
    randomElem :: forall a. [a] -> IO a
    randomElem [a]
    xs = do
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [a]
    xs) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO ()
    forall a. String -> IO a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "General.Extra.randomElem called with empty list, can't pick a random element"
        i <- (Int, Int) -> IO Int
    forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
    randomRIO (Int
    0, [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    xs Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
        pure $ xs !! i

    ---------------------------------------------------------------------
    -- System.IO

    usingLineBuffering :: Cleanup -> IO ()
    usingLineBuffering :: Cleanup -> IO ()
    usingLineBuffering Cleanup
    cleanup = do
        out <- Handle -> IO BufferMode
    hGetBuffering Handle
    stdout
        err <- hGetBuffering stderr
        when (out /= LineBuffering || err /= LineBuffering) $ do
            register cleanup $ hSetBuffering stdout out >> hSetBuffering stderr err
            hSetBuffering stdout LineBuffering >> hSetBuffering stderr LineBuffering

    ---------------------------------------------------------------------
    -- System.Time

    showDurationSecs :: Seconds -> String
    showDurationSecs :: Seconds -> String
    showDurationSecs = String -> String -> ShowS
    forall a. Eq a => [a] -> [a] -> [a] -> [a]
    replace String
    ".00s" String
    "s" ShowS -> (Seconds -> String) -> Seconds -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Seconds -> String
    showDuration (Seconds -> String) -> (Seconds -> Seconds) -> Seconds -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Seconds
    intToDouble (Int -> Seconds) -> (Seconds -> Int) -> Seconds -> Seconds
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Seconds -> Int
    forall b. Integral b => Seconds -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round

    ---------------------------------------------------------------------
    -- Control.Monad

    withs :: [(a -> r) -> r] -> ([a] -> r) -> r
    withs :: forall a r. [(a -> r) -> r] -> ([a] -> r) -> r
    withs [] [a] -> r
    act = [a] -> r
    act []
    withs ((a -> r) -> r
    f:[(a -> r) -> r]
    fs) [a] -> r
    act = (a -> r) -> r
    f ((a -> r) -> r) -> (a -> r) -> r
    forall a b. (a -> b) -> a -> b
    $ \a
    a -> [(a -> r) -> r] -> ([a] -> r) -> r
    forall a r. [(a -> r) -> r] -> ([a] -> r) -> r
    withs [(a -> r) -> r]
    fs (([a] -> r) -> r) -> ([a] -> r) -> r
    forall a b. (a -> b) -> a -> b
    $ \[a]
    as -> [a] -> r
    act ([a] -> r) -> [a] -> r
    forall a b. (a -> b) -> a -> b
    $ a
    aa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    as

    forNothingM :: Monad m => [a] -> (a -> m (Maybe b)) -> m (Maybe [b])
    forNothingM :: forall (m :: * -> *) a b.
    Monad m =>
    [a] -> (a -> m (Maybe b)) -> m (Maybe [b])
    forNothingM [] a -> m (Maybe b)
    f = Maybe [b] -> m (Maybe [b])
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe [b] -> m (Maybe [b])) -> Maybe [b] -> m (Maybe [b])
    forall a b. (a -> b) -> a -> b
    $ [b] -> Maybe [b]
    forall a. a -> Maybe a
    Just []
    forNothingM (a
    x:[a]
    xs) a -> m (Maybe b)
    f = do
        v <- a -> m (Maybe b)
    f a
    x
        case v of
            Maybe b
    Nothing -> Maybe [b] -> m (Maybe [b])
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe [b]
    forall a. Maybe a
    Nothing
            Just b
    v -> ([b] -> [b]) -> Maybe [b] -> Maybe [b]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (b
    vb -> [b] -> [b]
    forall a. a -> [a] -> [a]
    :) (Maybe [b] -> Maybe [b]) -> m (Maybe [b]) -> m (Maybe [b])
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` [a] -> (a -> m (Maybe b)) -> m (Maybe [b])
    forall (m :: * -> *) a b.
    Monad m =>
    [a] -> (a -> m (Maybe b)) -> m (Maybe [b])
    forNothingM [a]
    xs a -> m (Maybe b)
    f

    ---------------------------------------------------------------------
    -- Control.Concurrent

    usingNumCapabilities :: Cleanup -> Int -> IO ()
    usingNumCapabilities :: Cleanup -> Int -> IO ()
    usingNumCapabilities Cleanup
    cleanup Int
    new = Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    rtsSupportsBoundThreads (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        old <- IO Int
    getNumCapabilities
        when (old /= new) $ do
            register cleanup $ setNumCapabilities old
            setNumCapabilities new

    ---------------------------------------------------------------------
    -- Control.Exception

    -- | Is the exception asynchronous, not a "coding error" that should be ignored
    isAsyncException :: SomeException -> Bool
    isAsyncException :: SomeException -> Bool
    isAsyncException SomeException
    e
        | Just (AsyncException
    _ :: AsyncException) <- SomeException -> Maybe AsyncException
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e = Bool
    True
        | Just (ExitCode
    _ :: ExitCode) <- SomeException -> Maybe ExitCode
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e = Bool
    True
        | Bool
    otherwise = Bool
    False

    catchIO :: IO a -> (IOException -> IO a) -> IO a
    catchIO :: forall a. IO a -> (IOException -> IO a) -> IO a
    catchIO = IO a -> (IOException -> IO a) -> IO a
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    catch

    tryIO :: IO a -> IO (Either IOException a)
    tryIO :: forall a. IO a -> IO (Either IOException a)
    tryIO = IO a -> IO (Either IOException a)
    forall e a. Exception e => IO a -> IO (Either e a)
    try

    handleIO :: (IOException -> IO a) -> IO a -> IO a
    handleIO :: forall a. (IOException -> IO a) -> IO a -> IO a
    handleIO = (IOException -> IO a) -> IO a -> IO a
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
    handle

    handleSynchronous :: (SomeException -> IO a) -> IO a -> IO a
    handleSynchronous :: forall a. (SomeException -> IO a) -> IO a -> IO a
    handleSynchronous = (SomeException -> Bool) -> (SomeException -> IO a) -> IO a -> IO a
    forall e a.
    Exception e =>
    (e -> Bool) -> (e -> IO a) -> IO a -> IO a
    handleBool (Bool -> Bool
    not (Bool -> Bool) -> (SomeException -> Bool) -> SomeException -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SomeException -> Bool
    isAsyncException)

    ---------------------------------------------------------------------
    -- System.Directory

    doesFileExist_ :: FilePath -> IO Bool
    doesFileExist_ :: String -> IO Bool
    doesFileExist_ String
    x = String -> IO Bool
    doesFileExist String
    x IO Bool -> (IOException -> IO Bool) -> IO Bool
    forall a. IO a -> (IOException -> IO a) -> IO a
    `catchIO` \IOException
    _ -> Bool -> IO Bool
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False

    doesDirectoryExist_ :: FilePath -> IO Bool
    doesDirectoryExist_ :: String -> IO Bool
    doesDirectoryExist_ String
    x = String -> IO Bool
    doesDirectoryExist String
    x IO Bool -> (IOException -> IO Bool) -> IO Bool
    forall a. IO a -> (IOException -> IO a) -> IO a
    `catchIO` \IOException
    _ -> Bool -> IO Bool
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False

    -- | Remove a file, but don't worry if it fails
    removeFile_ :: FilePath -> IO ()
    removeFile_ :: String -> IO ()
    removeFile_ String
    x =
        String -> IO ()
    removeFile String
    x IO () -> (IOException -> IO ()) -> IO ()
    forall a. IO a -> (IOException -> IO a) -> IO a
    `catchIO` \IOException
    e ->
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (IOException -> Bool
    isPermissionError IOException
    e) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (IOException -> IO ()) -> IO () -> IO ()
    forall a. (IOException -> IO a) -> IO a -> IO a
    handleIO (\IOException
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                perms <- String -> IO Permissions
    getPermissions String
    x
                setPermissions x perms{readable = True, searchable = True, writable = True}
                removeFile x

    -- | Like @createDirectoryIfMissing True@ but faster, as it avoids
    --   any work in the common case the directory already exists.
    createDirectoryRecursive :: FilePath -> IO ()
    createDirectoryRecursive :: String -> IO ()
    createDirectoryRecursive String
    dir = do
        x <- IO Bool -> IO (Either IOException Bool)
    forall a. IO a -> IO (Either IOException a)
    tryIO (IO Bool -> IO (Either IOException Bool))
    -> IO Bool -> IO (Either IOException Bool)
    forall a b. (a -> b) -> a -> b
    $ String -> IO Bool
    doesDirectoryExist String
    dir
        when (x /= Right True) $ createDirectoryIfMissing True dir

    ---------------------------------------------------------------------
    -- Data.Either

    whenLeft :: Applicative m => Either a b -> (a -> m ()) -> m ()
    whenLeft :: forall (m :: * -> *) a b.
    Applicative m =>
    Either a b -> (a -> m ()) -> m ()
    whenLeft Either a b
    x a -> m ()
    f = (a -> m ()) -> (b -> m ()) -> Either a b -> m ()
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either a -> m ()
    f (m () -> b -> m ()
    forall a b. a -> b -> a
    const (m () -> b -> m ()) -> m () -> b -> m ()
    forall a b. (a -> b) -> a -> b
    $ () -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()) Either a b
    x

    ---------------------------------------------------------------------
    -- Data.CallStack

    type Located = Partial

    callStackTop :: Partial => String
    callStackTop :: HasCallStack => String
    callStackTop = (HasCallStack => String) -> String
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => String) -> String)
    -> (HasCallStack => String) -> String
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> String
    forall a. a -> [a] -> a
    headDef String
    "unknown location" [String]
    HasCallStack => [String]
    callStackFull

    callStackFull :: Partial => [String]
    callStackFromException :: SomeException -> ([String], SomeException)

    -- | Invert 'prettyCallStack', which GHC pre-applies in certain cases
    parseCallStack :: String -> [String]
    parseCallStack = [String] -> [String]
    forall a. [a] -> [a]
    reverse ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ShowS
    trimStart ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    forall a. [a] -> [a]
    drop1 ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines

    callStackFull :: HasCallStack => [String]
    callStackFull = String -> [String]
    parseCallStack (String -> [String]) -> String -> [String]
    forall a b. (a -> b) -> a -> b
    $ CallStack -> String
    prettyCallStack (CallStack -> String) -> CallStack -> String
    forall a b. (a -> b) -> a -> b
    $ CallStack -> CallStack
    popCallStack CallStack
    HasCallStack => CallStack
    callStack

    callStackFromException :: SomeException -> ([String], SomeException)
    callStackFromException (SomeException -> Maybe ErrorCall
    forall e. Exception e => SomeException -> Maybe e
    fromException -> Just (ErrorCallWithLocation String
    msg String
    loc)) = (String -> [String]
    parseCallStack String
    loc, ErrorCall -> SomeException
    forall e. Exception e => e -> SomeException
    toException (ErrorCall -> SomeException) -> ErrorCall -> SomeException
    forall a b. (a -> b) -> a -> b
    $ String -> ErrorCall
    ErrorCall String
    msg)
    callStackFromException SomeException
    e = ([], SomeException
    e)

    ---------------------------------------------------------------------
    -- Data.Version

    -- | A version number that indicates change, not ordering or compatibility.
    --   Always presented as an 'Int' to the user, but a newtype inside the library for safety.
    newtype Ver = Ver Int
        deriving (Int -> Ver -> ShowS
    [Ver] -> ShowS
    Ver -> String
    (Int -> Ver -> ShowS)
    -> (Ver -> String) -> ([Ver] -> ShowS) -> Show Ver
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Ver -> ShowS
    showsPrec :: Int -> Ver -> ShowS
    $cshow :: Ver -> String
    show :: Ver -> String
    $cshowList :: [Ver] -> ShowS
    showList :: [Ver] -> ShowS
    Show,Ver -> Ver -> Bool
    (Ver -> Ver -> Bool) -> (Ver -> Ver -> Bool) -> Eq Ver
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Ver -> Ver -> Bool
    == :: Ver -> Ver -> Bool
    $c/= :: Ver -> Ver -> Bool
    /= :: Ver -> Ver -> Bool
    Eq,Ptr Ver -> IO Ver
    Ptr Ver -> Int -> IO Ver
    Ptr Ver -> Int -> Ver -> IO ()
    Ptr Ver -> Ver -> IO ()
    Ver -> Int
    (Ver -> Int)
    -> (Ver -> Int)
    -> (Ptr Ver -> Int -> IO Ver)
    -> (Ptr Ver -> Int -> Ver -> IO ())
    -> (forall b. Ptr b -> Int -> IO Ver)
    -> (forall b. Ptr b -> Int -> Ver -> IO ())
    -> (Ptr Ver -> IO Ver)
    -> (Ptr Ver -> Ver -> IO ())
    -> Storable Ver
    forall b. Ptr b -> Int -> IO Ver
    forall b. Ptr b -> Int -> Ver -> IO ()
    forall a.
    (a -> Int)
    -> (a -> Int)
    -> (Ptr a -> Int -> IO a)
    -> (Ptr a -> Int -> a -> IO ())
    -> (forall b. Ptr b -> Int -> IO a)
    -> (forall b. Ptr b -> Int -> a -> IO ())
    -> (Ptr a -> IO a)
    -> (Ptr a -> a -> IO ())
    -> Storable a
    $csizeOf :: Ver -> Int
    sizeOf :: Ver -> Int
    $calignment :: Ver -> Int
    alignment :: Ver -> Int
    $cpeekElemOff :: Ptr Ver -> Int -> IO Ver
    peekElemOff :: Ptr Ver -> Int -> IO Ver
    $cpokeElemOff :: Ptr Ver -> Int -> Ver -> IO ()
    pokeElemOff :: Ptr Ver -> Int -> Ver -> IO ()
    $cpeekByteOff :: forall b. Ptr b -> Int -> IO Ver
    peekByteOff :: forall b. Ptr b -> Int -> IO Ver
    $cpokeByteOff :: forall b. Ptr b -> Int -> Ver -> IO ()
    pokeByteOff :: forall b. Ptr b -> Int -> Ver -> IO ()
    $cpeek :: Ptr Ver -> IO Ver
    peek :: Ptr Ver -> IO Ver
    $cpoke :: Ptr Ver -> Ver -> IO ()
    poke :: Ptr Ver -> Ver -> IO ()
    Storable)

    makeVer :: String -> Ver
    makeVer :: String -> Ver
    makeVer = Int -> Ver
    Ver (Int -> Ver) -> (String -> Int) -> String -> Ver
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Int
    forall a. Hashable a => a -> Int
    hash

    ---------------------------------------------------------------------
    -- Data.Typeable

    -- | Like TypeRep, but the Show includes enough information to be unique
    --   so I can rely on @a == b === show a == show b@.
    newtype QTypeRep = QTypeRep {QTypeRep -> TypeRep
    fromQTypeRep :: TypeRep}
        deriving (QTypeRep -> QTypeRep -> Bool
    (QTypeRep -> QTypeRep -> Bool)
    -> (QTypeRep -> QTypeRep -> Bool) -> Eq QTypeRep
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: QTypeRep -> QTypeRep -> Bool
    == :: QTypeRep -> QTypeRep -> Bool
    $c/= :: QTypeRep -> QTypeRep -> Bool
    /= :: QTypeRep -> QTypeRep -> Bool
    Eq,Eq QTypeRep
    Eq QTypeRep =>
    (Int -> QTypeRep -> Int) -> (QTypeRep -> Int) -> Hashable QTypeRep
    Int -> QTypeRep -> Int
    QTypeRep -> Int
    forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
    $chashWithSalt :: Int -> QTypeRep -> Int
    hashWithSalt :: Int -> QTypeRep -> Int
    $chash :: QTypeRep -> Int
    hash :: QTypeRep -> Int
    Hashable,QTypeRep -> ()
    (QTypeRep -> ()) -> NFData QTypeRep
    forall a. (a -> ()) -> NFData a
    $crnf :: QTypeRep -> ()
    rnf :: QTypeRep -> ()
    NFData)

    instance Show QTypeRep where
        -- Need to show enough so that different types with the same names don't clash
        -- But can't show too much or the history is not portable https://github.com/ndmitchell/shake/issues/670
        show :: QTypeRep -> String
    show (QTypeRep TypeRep
    x) = TypeRep -> String
    f TypeRep
    x
            where
                f :: TypeRep -> String
    f TypeRep
    x = [Char
    '(' | [TypeRep]
    xs [TypeRep] -> [TypeRep] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= []] String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ([String] -> String
    unwords ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ TyCon -> String
    g TyCon
    c String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (TypeRep -> String) -> [TypeRep] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map TypeRep -> String
    f [TypeRep]
    xs) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char
    ')' | [TypeRep]
    xs [TypeRep] -> [TypeRep] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= []]
                    where (TyCon
    c, [TypeRep]
    xs) = TypeRep -> (TyCon, [TypeRep])
    splitTyConApp TypeRep
    x
                g :: TyCon -> String
    g TyCon
    x = TyCon -> String
    tyConModule TyCon
    x String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "." String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ TyCon -> String
    tyConName TyCon
    x