{-# 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
maximumBy' :: (a -> a -> Ordering) -> [a] -> a
maximumBy' :: forall a. (a -> a -> Ordering) -> [a] -> a
maximumBy' a -> a -> Ordering
cmp = forall a. (a -> a -> a) -> [a] -> a
foldl1' forall a b. (a -> b) -> a -> b
$ \a
x a
y -> if a -> a -> Ordering
cmp a
x a
y 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' = forall a. (a -> a -> Ordering) -> [a] -> a
maximumBy' 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 forall a. a -> [a] -> [a]
: forall a b. [[a]] -> [b] -> [[b]]
unconcat [[a]]
as [b]
b2
where ([b]
b1,[b]
b2) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
a) [b]
bs
wrapQuote :: String -> String
wrapQuote :: ShowS
wrapQuote String
xs | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isSpace String
xs = String
"\"" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Char
x -> if Char
x forall a. Eq a => a -> a -> Bool
== Char
'\"' then String
"\"\"" else [Char
x]) String
xs forall a. [a] -> [a] -> [a]
++ String
"\""
| Bool
otherwise = String
xs
wrapBracket :: String -> String
wrapBracket :: ShowS
wrapBracket String
xs | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isSpace String
xs = String
"(" forall a. [a] -> [a] -> [a]
++ String
xs forall a. [a] -> [a] -> [a]
++ String
")"
| Bool
otherwise = String
xs
showBracket :: Show a => a -> String
showBracket :: forall a. Show a => a -> String
showBracket = ShowS
wrapBracket forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
fastAt :: [a] -> (Int -> Maybe a)
fastAt :: forall a. [a] -> Int -> Maybe a
fastAt [a]
xs = \Int
i -> if Int
i forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i forall a. Ord a => a -> a -> Bool
>= Int
n then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Array a -> Int -> a
indexArray Array a
arr Int
i
where
n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
arr :: Array a
arr = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
let n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
MutableArray s a
arr <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
n forall a. Partial => a
undefined
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Int
0 [a]
xs) forall a b. (a -> b) -> a -> b
$ \(Int
i,a
x) ->
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
arr Int
i a
x
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray s a
arr
zipWithExact :: Partial => (a -> b -> c) -> [a] -> [b] -> [c]
zipWithExact :: forall a b c. Partial => (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 forall a. a -> [a] -> [a]
: [a] -> [b] -> [c]
g [a]
as [b]
bs
g [a]
_ [b]
_ = forall a. Partial => String -> a
error String
"zipWithExacts: unequal lengths"
zipExact :: Partial => [a] -> [b] -> [(a,b)]
zipExact :: forall a b. Partial => [a] -> [b] -> [(a, b)]
zipExact = forall a b c. Partial => (a -> b -> c) -> [a] -> [b] -> [c]
zipWithExact (,)
{-# NOINLINE getProcessorCount #-}
getProcessorCount :: IO Int
getProcessorCount :: IO Int
getProcessorCount = let res :: Int
res = forall a. IO a -> a
unsafePerformIO IO Int
act in forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
res
where
act :: IO Int
act =
if Bool
rtsSupportsBoundThreads then
forall a b. (Integral a, Num b) => a -> b
fromIntegral 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
"")] <- forall a. Read a => ReadS a
reads String
s -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
Maybe String
_ -> do
String
src <- String -> IO String
readFile' String
"/proc/cpuinfo" forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
""
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [() | String
x <- String -> [String]
lines String
src, String
"processor" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x]
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
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if Bool
b then (Bool
True, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory String
gcc) else (Bool
False, forall a. Maybe a
Nothing)
Maybe String
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
False, forall a. Maybe a
Nothing)
Maybe String
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Maybe a -> Bool
isJust Maybe String
v, forall a. Maybe a
Nothing)
randomElem :: [a] -> IO a
randomElem :: forall a. [a] -> IO a
randomElem [a]
xs = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs) forall a b. (a -> b) -> a -> b
$ 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 <- forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
0, forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs forall a. Num a => a -> a -> a
- Int
1)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [a]
xs forall a. [a] -> Int -> a
!! Int
i
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
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BufferMode
out forall a. Eq a => a -> a -> Bool
/= BufferMode
LineBuffering Bool -> Bool -> Bool
|| BufferMode
err forall a. Eq a => a -> a -> Bool
/= BufferMode
LineBuffering) forall a b. (a -> b) -> a -> b
$ do
Cleanup -> IO () -> IO ReleaseKey
register Cleanup
cleanup forall a b. (a -> b) -> a -> b
$ Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
out 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> BufferMode -> IO ()
hSetBuffering Handle
stderr BufferMode
LineBuffering
showDurationSecs :: Seconds -> String
showDurationSecs :: Seconds -> String
showDurationSecs = forall a. (Partial, Eq a) => [a] -> [a] -> [a] -> [a]
replace String
".00s" String
"s" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seconds -> String
showDuration forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Seconds
intToDouble forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
round
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 forall a b. (a -> b) -> a -> b
$ \a
a -> forall a r. [(a -> r) -> r] -> ([a] -> r) -> r
withs [(a -> r) -> r]
fs forall a b. (a -> b) -> a -> b
$ \[a]
as -> [a] -> r
act forall a b. (a -> b) -> a -> b
$ a
aforall 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just b
v -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (b
vforall a. a -> [a] -> [a]
:) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m (Maybe [b])
forNothingM [a]
xs a -> m (Maybe b)
f
usingNumCapabilities :: Cleanup -> Int -> IO ()
usingNumCapabilities :: Cleanup -> Int -> IO ()
usingNumCapabilities Cleanup
cleanup Int
new = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
rtsSupportsBoundThreads forall a b. (a -> b) -> a -> b
$ do
Int
old <- IO Int
getNumCapabilities
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
old forall a. Eq a => a -> a -> Bool
/= Int
new) forall a b. (a -> b) -> a -> b
$ do
Cleanup -> IO () -> IO ReleaseKey
register Cleanup
cleanup forall a b. (a -> b) -> a -> b
$ Int -> IO ()
setNumCapabilities Int
old
Int -> IO ()
setNumCapabilities Int
new
isAsyncException :: SomeException -> Bool
isAsyncException :: SomeException -> Bool
isAsyncException SomeException
e
| Just (AsyncException
_ :: AsyncException) <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e = Bool
True
| Just (ExitCode
_ :: 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 = 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 = 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 = 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 = forall e a.
Exception e =>
(e -> Bool) -> (e -> IO a) -> IO a -> IO a
handleBool (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Bool
isAsyncException)
doesFileExist_ :: FilePath -> IO Bool
doesFileExist_ :: String -> IO Bool
doesFileExist_ String
x = String -> IO Bool
doesFileExist String
x forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> 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 forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
removeFile_ :: FilePath -> IO ()
removeFile_ :: String -> IO ()
removeFile_ String
x =
String -> IO ()
removeFile String
x forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
e ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IOException -> Bool
isPermissionError IOException
e) forall a b. (a -> b) -> a -> b
$ forall a. (IOException -> IO a) -> IO a -> IO a
handleIO (\IOException
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) 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
createDirectoryRecursive :: FilePath -> IO ()
createDirectoryRecursive :: String -> IO ()
createDirectoryRecursive String
dir = do
Either IOException Bool
x <- forall a. IO a -> IO (Either IOException a)
tryIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
dir
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Either IOException Bool
x forall a. Eq a => a -> a -> Bool
/= forall a b. b -> Either a b
Right Bool
True) forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
dir
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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> m ()
f (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Either a b
x
type Located = Partial
callStackTop :: Partial => String
callStackTop :: Partial => String
callStackTop = forall a. Partial => (Partial => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> a
headDef String
"unknown location" Partial => [String]
callStackFull
callStackFull :: Partial => [String]
callStackFromException :: SomeException -> ([String], SomeException)
parseCallStack :: String -> [String]
parseCallStack = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ShowS
trimStart forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
drop1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
callStackFull :: Partial => [String]
callStackFull = String -> [String]
parseCallStack forall a b. (a -> b) -> a -> b
$ CallStack -> String
prettyCallStack forall a b. (a -> b) -> a -> b
$ CallStack -> CallStack
popCallStack Partial => CallStack
callStack
callStackFromException :: SomeException -> ([String], SomeException)
callStackFromException (forall e. Exception e => SomeException -> Maybe e
fromException -> Just (ErrorCallWithLocation String
msg String
loc)) = (String -> [String]
parseCallStack String
loc, forall e. Exception e => e -> SomeException
toException forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
msg)
callStackFromException SomeException
e = ([], SomeException
e)
newtype Ver = Ver Int
deriving (Int -> Ver -> ShowS
[Ver] -> ShowS
Ver -> String
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
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 Ver -> IO Ver
Ptr Ver -> Int -> IO Ver
Ptr Ver -> Int -> Ver -> IO ()
Ptr Ver -> Ver -> IO ()
Ver -> Int
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 :: forall b. Ptr b -> Int -> Ver -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Ver -> IO ()
peekByteOff :: forall b. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Hashable a => a -> Int
hash
newtype QTypeRep = QTypeRep {QTypeRep -> TypeRep
fromQTypeRep :: TypeRep}
deriving (QTypeRep -> QTypeRep -> Bool
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,Eq QTypeRep
Int -> QTypeRep -> Int
QTypeRep -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: QTypeRep -> Int
$chash :: QTypeRep -> Int
hashWithSalt :: Int -> QTypeRep -> Int
$chashWithSalt :: Int -> QTypeRep -> Int
Hashable,QTypeRep -> ()
forall a. (a -> ()) -> NFData a
rnf :: QTypeRep -> ()
$crnf :: QTypeRep -> ()
NFData)
instance Show QTypeRep where
show :: QTypeRep -> String
show (QTypeRep TypeRep
x) = TypeRep -> String
f TypeRep
x
where
f :: TypeRep -> String
f TypeRep
x = [Char
'(' | [TypeRep]
xs forall a. Eq a => a -> a -> Bool
/= []] forall a. [a] -> [a] -> [a]
++ ([String] -> String
unwords forall a b. (a -> b) -> a -> b
$ TyCon -> String
g TyCon
c forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map TypeRep -> String
f [TypeRep]
xs) forall a. [a] -> [a] -> [a]
++ [Char
')' | [TypeRep]
xs 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 forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ TyCon -> String
tyConName TyCon
x