module General.Extra(
getProcessorCount,
withResultType,
randomElem,
wrapQuote, showBracket,
withs,
maximum', maximumBy',
fastAt,
isAsyncException
) where
import Control.Exception.Extra
import Data.Char
import Data.List
import System.Environment.Extra
import System.IO.Extra
import System.IO.Unsafe
import System.Random
import System.Exit
import Control.Concurrent
import Data.Functor
import Data.Primitive.Array
import Control.Monad
import Control.Monad.ST
import GHC.Conc(getNumProcessors)
import Prelude
maximumBy' :: (a -> a -> Ordering) -> [a] -> a
maximumBy' cmp = foldl1' $ \x y -> if cmp x y == GT then x else y
maximum' :: Ord a => [a] -> a
maximum' = maximumBy' compare
wrapQuote :: String -> String
wrapQuote xs | any isSpace xs = "\"" ++ concatMap (\x -> if x == '\"' then "\"\"" else [x]) xs ++ "\""
| otherwise = xs
wrapBracket :: String -> String
wrapBracket xs | any isSpace xs = "(" ++ xs ++ ")"
| otherwise = xs
showBracket :: Show a => a -> String
showBracket = wrapBracket . show
fastAt :: [a] -> (Int -> Maybe a)
fastAt xs = \i -> if i < 0 || i >= n then Nothing else Just $ indexArray arr i
where
n = length xs
arr = runST $ do
let n = length xs
arr <- newArray n undefined
forM_ (zip [0..] xs) $ \(i,x) ->
writeArray arr i x
unsafeFreezeArray arr
getProcessorCount :: IO Int
getProcessorCount = let res = unsafePerformIO act in return res
where
act =
if rtsSupportsBoundThreads then
fromIntegral <$> getNumProcessors
else
handle_ (const $ return 1) $ do
env <- lookupEnv "NUMBER_OF_PROCESSORS"
case env of
Just s | [(i,"")] <- reads s -> return i
_ -> do
src <- readFile' "/proc/cpuinfo"
return $! length [() | x <- lines src, "processor" `isPrefixOf` x]
randomElem :: [a] -> IO a
randomElem xs = do
i <- randomRIO (0, length xs 1)
return $ xs !! i
withs :: [(a -> r) -> r] -> ([a] -> r) -> r
withs [] act = act []
withs (f:fs) act = f $ \a -> withs fs $ \as -> act $ a:as
isAsyncException :: SomeException -> Bool
isAsyncException e
| Just (_ :: AsyncException) <- fromException e = True
| Just (_ :: ExitCode) <- fromException e = True
| otherwise = False
withResultType :: (Maybe a -> a) -> a
withResultType f = f Nothing