{-# LANGUAGE ScopedTypeVariables, ConstraintKinds, GeneralizedNewtypeDeriving, ViewPatterns #-}

module General.Extra(
    getProcessorCount,
    findGcc,
    whenLeft,
    randomElem,
    wrapQuote, showBracket,
    withs, forNothingM,
    maximum', maximumBy',
    unconcat,
    fastAt,
    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' :: (a -> a -> Ordering) -> [a] -> a
maximumBy' a -> a -> Ordering
cmp = (a -> a -> a) -> [a] -> a
forall a. (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' :: [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 :: [[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 (t :: * -> *) a. Foldable t => t a -> Int
length [a]
a) [b]
bs


---------------------------------------------------------------------
-- 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 :: 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 :: [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 (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 (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
            MutableArray s a
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
            [(Int, a)] -> ((Int, a) -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Int -> [a] -> [(Int, a)]
forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Int
0 [a]
xs) (((Int, a) -> ST s ()) -> ST s ())
-> ((Int, a) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(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
            MutableArray (PrimState (ST s)) a -> ST s (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray s a
MutableArray (PrimState (ST s)) a
arr

zipWithExact :: Partial => (a -> b -> c) -> [a] -> [b] -> [c]
zipWithExact :: (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 :: [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 (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
                Maybe String
env <- String -> IO (Maybe String)
lookupEnv String
"NUMBER_OF_PROCESSORS"
                case Maybe String
env of
                    Just String
s | [(Int
i,String
"")] <- ReadS Int
forall a. Read a => ReadS a
reads String
s -> Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
                    Maybe String
_ -> do
                        String
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 (f :: * -> *) a. Applicative f => a -> f a
pure String
""
                        Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$! Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [() | String
x <- String -> [String]
lines String
src, String
"processor" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
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
    Maybe String
v <- String -> IO (Maybe String)
findExecutable String
"gcc"
    case Maybe String
v of
        Maybe String
Nothing | Bool
isWindows -> do
            Maybe String
ghc <- String -> IO (Maybe String)
findExecutable String
"ghc"
            case Maybe String
ghc of
                Just String
ghc -> do
                    let gcc :: String
gcc = ShowS
takeDirectory (ShowS
takeDirectory String
ghc) String -> ShowS
</> String
"mingw/bin/gcc.exe"
                    Bool
b <- String -> IO Bool
doesFileExist_ String
gcc
                    (Bool, Maybe String) -> IO (Bool, Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Bool, Maybe String) -> IO (Bool, Maybe String))
-> (Bool, Maybe String) -> IO (Bool, Maybe String)
forall a b. (a -> b) -> a -> b
$ if Bool
b then (Bool
True, String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory String
gcc) else (Bool
False, Maybe String
forall a. Maybe a
Nothing)
                Maybe String
_ -> (Bool, Maybe String) -> IO (Bool, Maybe String)
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 (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 :: [a] -> IO a
randomElem [a]
xs = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([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 (m :: * -> *) a. MonadFail m => String -> m a
fail String
"General.Extra.randomElem called with empty list, can't pick a random element"
    Int
i <- (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
0, [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)
    a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ [a]
xs [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
i


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

usingLineBuffering :: Cleanup -> IO ()
usingLineBuffering :: Cleanup -> IO ()
usingLineBuffering Cleanup
cleanup = do
    BufferMode
out <- Handle -> IO BufferMode
hGetBuffering Handle
stdout
    BufferMode
err <- Handle -> IO BufferMode
hGetBuffering Handle
stderr
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BufferMode
out BufferMode -> BufferMode -> Bool
forall a. Eq a => a -> a -> Bool
/= BufferMode
LineBuffering Bool -> Bool -> Bool
|| BufferMode
err BufferMode -> BufferMode -> Bool
forall a. Eq a => a -> a -> Bool
/= BufferMode
LineBuffering) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Cleanup -> IO () -> IO ReleaseKey
register Cleanup
cleanup (IO () -> IO ReleaseKey) -> IO () -> IO ReleaseKey
forall a b. (a -> b) -> a -> b
$ Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
out IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> BufferMode -> IO ()
hSetBuffering Handle
stderr BufferMode
err
        Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
LineBuffering IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> BufferMode -> IO ()
hSetBuffering Handle
stderr BufferMode
LineBuffering


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

showDurationSecs :: Seconds -> String
showDurationSecs :: Seconds -> String
showDurationSecs = String -> String -> ShowS
forall a. (HasCallStack, 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 a b. (RealFrac a, Integral b) => a -> b
round


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

withs :: [(a -> r) -> r] -> ([a] -> r) -> r
withs :: [(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 :: [a] -> (a -> m (Maybe b)) -> m (Maybe [b])
forNothingM [] a -> m (Maybe b)
f = Maybe [b] -> m (Maybe [b])
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
    Maybe b
v <- a -> m (Maybe b)
f a
x
    case Maybe b
v of
        Maybe b
Nothing -> Maybe [b] -> m (Maybe [b])
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
    Int
old <- IO Int
getNumCapabilities
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
old Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
new) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Cleanup -> IO () -> IO ReleaseKey
register Cleanup
cleanup (IO () -> IO ReleaseKey) -> IO () -> IO ReleaseKey
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
setNumCapabilities Int
old
        Int -> IO ()
setNumCapabilities Int
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 :: 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 :: 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 :: (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 :: (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 (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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure ()) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            Permissions
perms <- String -> IO Permissions
getPermissions String
x
            String -> Permissions -> IO ()
setPermissions String
x Permissions
perms{readable :: Bool
readable = Bool
True, searchable :: Bool
searchable = Bool
True, writable :: Bool
writable = Bool
True}
            String -> IO ()
removeFile String
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
    Either IOException Bool
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
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Either IOException Bool
x Either IOException Bool -> Either IOException Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool -> Either IOException Bool
forall a b. b -> Either a b
Right Bool
True) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
dir


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

whenLeft :: Applicative m => Either a b -> (a -> m ()) -> m ()
whenLeft :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure ()) Either a b
x


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

type Located = Partial

callStackTop :: Partial => String
callStackTop :: 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 :: [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 compatibilty.
--   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
showList :: [Ver] -> ShowS
$cshowList :: [Ver] -> ShowS
show :: Ver -> String
$cshow :: Ver -> String
showsPrec :: Int -> Ver -> ShowS
$cshowsPrec :: Int -> Ver -> ShowS
Show,Ver -> Ver -> Bool
(Ver -> Ver -> Bool) -> (Ver -> Ver -> Bool) -> Eq Ver
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ver -> Ver -> Bool
$c/= :: Ver -> Ver -> Bool
== :: Ver -> Ver -> Bool
$c== :: Ver -> Ver -> Bool
Eq,Ptr b -> Int -> IO Ver
Ptr b -> Int -> Ver -> IO ()
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
poke :: Ptr Ver -> Ver -> IO ()
$cpoke :: Ptr Ver -> Ver -> IO ()
peek :: Ptr Ver -> IO Ver
$cpeek :: Ptr Ver -> IO Ver
pokeByteOff :: Ptr b -> Int -> Ver -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Ver -> IO ()
peekByteOff :: Ptr b -> Int -> IO Ver
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Ver
pokeElemOff :: Ptr Ver -> Int -> Ver -> IO ()
$cpokeElemOff :: Ptr Ver -> Int -> Ver -> IO ()
peekElemOff :: Ptr Ver -> Int -> IO Ver
$cpeekElemOff :: Ptr Ver -> Int -> IO Ver
alignment :: Ver -> Int
$calignment :: Ver -> Int
sizeOf :: Ver -> Int
$csizeOf :: Ver -> Int
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
/= :: QTypeRep -> QTypeRep -> Bool
$c/= :: QTypeRep -> QTypeRep -> Bool
== :: QTypeRep -> QTypeRep -> Bool
$c== :: QTypeRep -> QTypeRep -> Bool
Eq,Int -> QTypeRep -> Int
QTypeRep -> Int
(Int -> QTypeRep -> Int) -> (QTypeRep -> Int) -> Hashable QTypeRep
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: QTypeRep -> Int
$chash :: QTypeRep -> Int
hashWithSalt :: Int -> QTypeRep -> Int
$chashWithSalt :: Int -> QTypeRep -> Int
Hashable,QTypeRep -> ()
(QTypeRep -> ()) -> NFData QTypeRep
forall a. (a -> ()) -> NFData a
rnf :: QTypeRep -> ()
$crnf :: 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