{-# LANGUAGE PatternGuards, ViewPatterns, CPP, ScopedTypeVariables #-}

module General.Util(
    PkgName, ModName,
    URL,
    pretty, parseMode, applyType, applyFun1, unapplyFun, fromName, fromQName, fromTyVarBind, declNames, isTypeSig,
    fromDeclHead, fromContext, fromIParen, fromInstHead,
    tarballReadFiles,
    isUpper1, isAlpha1,
    joinPair,
    testing, testEq,
    showUTCTime,
    strict,
    withs,
    escapeHTML, unescapeHTML, unHTML,
    escapeURL,
    takeSortOn,
    Average, toAverage, fromAverage,
    inRanges,
    parseTrailingVersion,
    trimVersion,
    exitFail,
    prettyTable,
    getStatsPeakAllocBytes, getStatsCurrentLiveBytes, getStatsDebug,
    hackagePackageURL, hackageModuleURL, hackageDeclURL, ghcModuleURL,
    minimum', maximum',
    general_util_test
    ) where

import Language.Haskell.Exts
import Control.Applicative
import Data.List.Extra
import Data.Char
import Data.Either.Extra
import Data.Semigroup
import Data.Tuple.Extra
import Control.Monad.Extra
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Map as Map
import Data.Ix
import Numeric.Extra
import Codec.Compression.GZip as GZip
import Codec.Archive.Tar as Tar
import Data.Time.Clock
import Data.Time.Format
import Control.DeepSeq
import Control.Exception.Extra
import Test.QuickCheck
import Data.Version
import Data.Int
import System.IO
import System.Exit
import System.Mem
import GHC.Stats
import General.Str
import Prelude
import qualified Network.HTTP.Types.URI as URI
import qualified Data.ByteString.UTF8 as UTF8


type PkgName = Str
type ModName = Str

-- | A URL, complete with a @https:@ prefix.
type URL = String

#if __GLASGOW_HASKELL__ >= 802
#define RTS_STATS 1
#endif

showMb :: (Show a, Integral a) => a -> String
#if RTS_STATS
showMb :: a -> String
showMb x :: a
x = a -> String
forall a. Show a => a -> String
show (a
x a -> a -> a
forall a. Integral a => a -> a -> a
`div` (1024a -> a -> a
forall a. Num a => a -> a -> a
*1024)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "Mb"
#else
showMb x = show x ++ "Mb"
#endif


#if RTS_STATS
withRTSStats :: (RTSStats -> a) -> IO (Maybe a)
withRTSStats :: (RTSStats -> a) -> IO (Maybe a)
withRTSStats f :: RTSStats -> a
f = IO Bool -> IO (Maybe a) -> IO (Maybe a) -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM IO Bool
getRTSStatsEnabled (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (RTSStats -> a) -> RTSStats -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> a
f (RTSStats -> Maybe a) -> IO RTSStats -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO RTSStats
getRTSStats) (Maybe a -> IO (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)
#else
withGCStats :: (GCStats -> a) -> IO (Maybe a)
withGCStats f = ifM getGCStatsEnabled (Just . f <$> getGCStats) (pure Nothing)
#endif

getStatsCurrentLiveBytes :: IO (Maybe String)
getStatsCurrentLiveBytes :: IO (Maybe String)
getStatsCurrentLiveBytes = do
    IO ()
performGC
#if RTS_STATS
    (RTSStats -> String) -> IO (Maybe String)
forall a. (RTSStats -> a) -> IO (Maybe a)
withRTSStats ((RTSStats -> String) -> IO (Maybe String))
-> (RTSStats -> String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ Word64 -> String
forall a. (Show a, Integral a) => a -> String
showMb (Word64 -> String) -> (RTSStats -> Word64) -> RTSStats -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GCDetails -> Word64
gcdetails_live_bytes (GCDetails -> Word64)
-> (RTSStats -> GCDetails) -> RTSStats -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> GCDetails
gc
#else
    withGCStats $ showMb . currentBytesUsed
#endif

getStatsPeakAllocBytes :: IO (Maybe String)
getStatsPeakAllocBytes :: IO (Maybe String)
getStatsPeakAllocBytes = do
#if RTS_STATS
    (RTSStats -> String) -> IO (Maybe String)
forall a. (RTSStats -> a) -> IO (Maybe a)
withRTSStats ((RTSStats -> String) -> IO (Maybe String))
-> (RTSStats -> String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ Word64 -> String
forall a. (Show a, Integral a) => a -> String
showMb (Word64 -> String) -> (RTSStats -> Word64) -> RTSStats -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
max_mem_in_use_bytes
#else
    withGCStats $ showMb . peakMegabytesAllocated
#endif

getStatsDebug :: IO (Maybe String)
getStatsDebug :: IO (Maybe String)
getStatsDebug = do
    let dump :: RTSStats -> String
dump = String -> String -> String -> String
forall a. (Partial, Eq a) => [a] -> [a] -> [a] -> [a]
replace ", " "\n" (String -> String) -> (RTSStats -> String) -> RTSStats -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '}') (String -> String) -> (RTSStats -> String) -> RTSStats -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
drop1 (String -> String) -> (RTSStats -> String) -> RTSStats -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '{') (String -> String) -> (RTSStats -> String) -> RTSStats -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> String
forall a. Show a => a -> String
show
#if RTS_STATS
    (RTSStats -> String) -> IO (Maybe String)
forall a. (RTSStats -> a) -> IO (Maybe a)
withRTSStats RTSStats -> String
dump
#else
    withGCStats dump
#endif



exitFail :: String -> IO ()
exitFail :: String -> IO ()
exitFail msg :: String
msg = do
    Handle -> String -> IO ()
hPutStrLn Handle
stderr String
msg
    IO ()
forall a. IO a
exitFailure

pretty :: Pretty a => a -> String
pretty :: a -> String
pretty = PPHsMode -> a -> String
forall a. Pretty a => PPHsMode -> a -> String
prettyPrintWithMode PPHsMode
defaultMode{layout :: PPLayout
layout=PPLayout
PPNoLayout}


parseMode :: ParseMode
parseMode :: ParseMode
parseMode = ParseMode
defaultParseMode{extensions :: [Extension]
extensions=(KnownExtension -> Extension) -> [KnownExtension] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map KnownExtension -> Extension
EnableExtension [KnownExtension]
es}
    where es :: [KnownExtension]
es = [KnownExtension
ConstraintKinds,KnownExtension
EmptyDataDecls,KnownExtension
TypeOperators,KnownExtension
ExplicitForAll,KnownExtension
GADTs,KnownExtension
KindSignatures,KnownExtension
MultiParamTypeClasses
               ,KnownExtension
TypeFamilies,KnownExtension
FlexibleContexts,KnownExtension
FunctionalDependencies,KnownExtension
ImplicitParams,KnownExtension
MagicHash,KnownExtension
UnboxedTuples
               ,KnownExtension
ParallelArrays,KnownExtension
UnicodeSyntax,KnownExtension
DataKinds,KnownExtension
PolyKinds,KnownExtension
PatternSynonyms]

applyType :: Type a -> [Type a] -> Type a
applyType :: Type a -> [Type a] -> Type a
applyType x :: Type a
x (t :: Type a
t:ts :: [Type a]
ts) = Type a -> [Type a] -> Type a
forall a. Type a -> [Type a] -> Type a
applyType (a -> Type a -> Type a -> Type a
forall l. l -> Type l -> Type l -> Type l
TyApp (Type a -> a
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Type a
t) Type a
x Type a
t) [Type a]
ts
applyType x :: Type a
x [] = Type a
x

applyFun1 :: [Type a] -> Type a
applyFun1 :: [Type a] -> Type a
applyFun1 [x :: Type a
x] = Type a
x
applyFun1 (x :: Type a
x:xs :: [Type a]
xs) = a -> Type a -> Type a -> Type a
forall l. l -> Type l -> Type l -> Type l
TyFun (Type a -> a
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Type a
x) Type a
x (Type a -> Type a) -> Type a -> Type a
forall a b. (a -> b) -> a -> b
$ [Type a] -> Type a
forall a. [Type a] -> Type a
applyFun1 [Type a]
xs

unapplyFun :: Type a -> [Type a]
unapplyFun :: Type a -> [Type a]
unapplyFun (TyFun _ x :: Type a
x y :: Type a
y) = Type a
x Type a -> [Type a] -> [Type a]
forall a. a -> [a] -> [a]
: Type a -> [Type a]
forall a. Type a -> [Type a]
unapplyFun Type a
y
unapplyFun x :: Type a
x = [Type a
x]


fromName :: Name a -> String
fromName :: Name a -> String
fromName (Ident _ x :: String
x) = String
x
fromName (Symbol _ x :: String
x) = String
x

fromQName :: QName a -> String
fromQName :: QName a -> String
fromQName (Qual _ _ x :: Name a
x) = Name a -> String
forall a. Name a -> String
fromName Name a
x
fromQName (UnQual _ x :: Name a
x) = Name a -> String
forall a. Name a -> String
fromName Name a
x
fromQName (Special _ UnitCon{}) = "()"
fromQName (Special _ ListCon{}) = "[]"
fromQName (Special _ FunCon{}) = "->"
fromQName (Special _ (TupleCon _ box :: Boxed
box n :: Int
n)) = "(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n ',' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")"
    where h :: String
h = ['#' | Boxed
box Boxed -> Boxed -> Bool
forall a. Eq a => a -> a -> Bool
== Boxed
Unboxed]
fromQName (Special _ UnboxedSingleCon{}) = "(##)"
fromQName (Special _ Cons{}) = ":"

fromContext :: Context a -> [Asst a]
fromContext :: Context a -> [Asst a]
fromContext (CxSingle _ x :: Asst a
x) = [Asst a
x]
fromContext (CxTuple _ xs :: [Asst a]
xs) = [Asst a]
xs
fromContext _ = []

fromIParen :: InstRule a -> InstRule a
fromIParen :: InstRule a -> InstRule a
fromIParen (IParen _ x :: InstRule a
x) = InstRule a -> InstRule a
forall a. InstRule a -> InstRule a
fromIParen InstRule a
x
fromIParen x :: InstRule a
x = InstRule a
x

fromTyVarBind :: TyVarBind a -> Name a
fromTyVarBind :: TyVarBind a -> Name a
fromTyVarBind (KindedVar _ x :: Name a
x _) = Name a
x
fromTyVarBind (UnkindedVar _ x :: Name a
x) = Name a
x

fromDeclHead :: DeclHead a -> (Name a, [TyVarBind a])
fromDeclHead :: DeclHead a -> (Name a, [TyVarBind a])
fromDeclHead (DHead _ n :: Name a
n) = (Name a
n, [])
fromDeclHead (DHInfix _ x :: TyVarBind a
x n :: Name a
n) = (Name a
n, [TyVarBind a
x])
fromDeclHead (DHParen _ x :: DeclHead a
x) = DeclHead a -> (Name a, [TyVarBind a])
forall a. DeclHead a -> (Name a, [TyVarBind a])
fromDeclHead DeclHead a
x
fromDeclHead (DHApp _ dh :: DeclHead a
dh x :: TyVarBind a
x) = ([TyVarBind a] -> [TyVarBind a])
-> (Name a, [TyVarBind a]) -> (Name a, [TyVarBind a])
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second ([TyVarBind a] -> [TyVarBind a] -> [TyVarBind a]
forall a. [a] -> [a] -> [a]
++[TyVarBind a
x]) ((Name a, [TyVarBind a]) -> (Name a, [TyVarBind a]))
-> (Name a, [TyVarBind a]) -> (Name a, [TyVarBind a])
forall a b. (a -> b) -> a -> b
$ DeclHead a -> (Name a, [TyVarBind a])
forall a. DeclHead a -> (Name a, [TyVarBind a])
fromDeclHead DeclHead a
dh

fromInstHead :: InstHead a -> (QName a, [Type a])
fromInstHead :: InstHead a -> (QName a, [Type a])
fromInstHead (IHCon _ n :: QName a
n) = (QName a
n, [])
fromInstHead (IHInfix _ x :: Type a
x n :: QName a
n) = (QName a
n, [Type a
x])
fromInstHead (IHParen _ x :: InstHead a
x) = InstHead a -> (QName a, [Type a])
forall a. InstHead a -> (QName a, [Type a])
fromInstHead InstHead a
x
fromInstHead (IHApp _ ih :: InstHead a
ih x :: Type a
x) = ([Type a] -> [Type a])
-> (QName a, [Type a]) -> (QName a, [Type a])
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second ([Type a] -> [Type a] -> [Type a]
forall a. [a] -> [a] -> [a]
++[Type a
x]) ((QName a, [Type a]) -> (QName a, [Type a]))
-> (QName a, [Type a]) -> (QName a, [Type a])
forall a b. (a -> b) -> a -> b
$ InstHead a -> (QName a, [Type a])
forall a. InstHead a -> (QName a, [Type a])
fromInstHead InstHead a
ih

declNames :: Decl a -> [String]
declNames :: Decl a -> [String]
declNames x :: Decl a
x = (Name a -> String) -> [Name a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Name a -> String
forall a. Name a -> String
fromName ([Name a] -> [String]) -> [Name a] -> [String]
forall a b. (a -> b) -> a -> b
$ case Decl a
x of
    TypeDecl _ hd :: DeclHead a
hd _ -> DeclHead a -> [Name a]
forall a. DeclHead a -> [Name a]
f DeclHead a
hd
    DataDecl _ _ _ hd :: DeclHead a
hd _ _ -> DeclHead a -> [Name a]
forall a. DeclHead a -> [Name a]
f DeclHead a
hd
    GDataDecl _ _ _ hd :: DeclHead a
hd _ _ _ -> DeclHead a -> [Name a]
forall a. DeclHead a -> [Name a]
f DeclHead a
hd
    TypeFamDecl _ hd :: DeclHead a
hd _ _ -> DeclHead a -> [Name a]
forall a. DeclHead a -> [Name a]
f DeclHead a
hd
    DataFamDecl _ _ hd :: DeclHead a
hd _ -> DeclHead a -> [Name a]
forall a. DeclHead a -> [Name a]
f DeclHead a
hd
    ClassDecl _ _ hd :: DeclHead a
hd _ _ -> DeclHead a -> [Name a]
forall a. DeclHead a -> [Name a]
f DeclHead a
hd
    TypeSig _ names :: [Name a]
names _ -> [Name a]
names
    PatSynSig _ names :: [Name a]
names _ _ _ _ _ -> [Name a]
names
    _ -> []
    where f :: DeclHead a -> [Name a]
f x :: DeclHead a
x = [(Name a, [TyVarBind a]) -> Name a
forall a b. (a, b) -> a
fst ((Name a, [TyVarBind a]) -> Name a)
-> (Name a, [TyVarBind a]) -> Name a
forall a b. (a -> b) -> a -> b
$ DeclHead a -> (Name a, [TyVarBind a])
forall a. DeclHead a -> (Name a, [TyVarBind a])
fromDeclHead DeclHead a
x]


isTypeSig :: Decl a -> Bool
isTypeSig :: Decl a -> Bool
isTypeSig TypeSig{} = Bool
True
isTypeSig PatSynSig{} = Bool
True
isTypeSig _ = Bool
False


tarballReadFiles :: FilePath -> IO [(FilePath, LBS.ByteString)]
tarballReadFiles :: String -> IO [(String, ByteString)]
tarballReadFiles file :: String
file = Entries FormatError -> [(String, ByteString)]
forall a. Show a => Entries a -> [(String, ByteString)]
f (Entries FormatError -> [(String, ByteString)])
-> (ByteString -> Entries FormatError)
-> ByteString
-> [(String, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Entries FormatError
Tar.read (ByteString -> Entries FormatError)
-> (ByteString -> ByteString) -> ByteString -> Entries FormatError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZip.decompress (ByteString -> [(String, ByteString)])
-> IO ByteString -> IO [(String, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
LBS.readFile String
file
    where
        f :: Entries a -> [(String, ByteString)]
f (Next e :: Entry
e rest :: Entries a
rest) | NormalFile body :: ByteString
body _ <- Entry -> EntryContent
entryContent Entry
e = (Entry -> String
entryPath Entry
e, ByteString
body) (String, ByteString)
-> [(String, ByteString)] -> [(String, ByteString)]
forall a. a -> [a] -> [a]
: Entries a -> [(String, ByteString)]
f Entries a
rest
        f (Next _ rest :: Entries a
rest) = Entries a -> [(String, ByteString)]
f Entries a
rest
        f Done = []
        f (Fail e :: a
e) = String -> [(String, ByteString)]
forall a. Partial => String -> a
error (String -> [(String, ByteString)])
-> String -> [(String, ByteString)]
forall a b. (a -> b) -> a -> b
$ "tarballReadFiles on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
e


innerTextHTML :: String -> String
innerTextHTML :: String -> String
innerTextHTML ('<':xs :: String
xs) = String -> String
innerTextHTML (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
drop1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '>') String
xs
innerTextHTML (x :: Char
x:xs :: String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
innerTextHTML String
xs
innerTextHTML [] = []

unHTML :: String -> String
unHTML :: String -> String
unHTML = String -> String
unescapeHTML (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
innerTextHTML

escapeURL :: String -> String
escapeURL :: String -> String
escapeURL = ByteString -> String
UTF8.toString (ByteString -> String)
-> (String -> ByteString) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ByteString -> ByteString
URI.urlEncode Bool
True (ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
UTF8.fromString

isUpper1 :: String -> Bool
isUpper1 (x :: Char
x:xs :: String
xs) = Char -> Bool
isUpper Char
x
isUpper1 _ = Bool
False

isAlpha1 :: String -> Bool
isAlpha1 (x :: Char
x:xs :: String
xs) = Char -> Bool
isAlpha Char
x
isAlpha1 [] = Bool
False

splitPair :: String -> String -> (String, String)
splitPair :: String -> String -> (String, String)
splitPair x :: String
x y :: String
y | (a :: String
a,String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
x -> Just b :: String
b) <- String -> String -> (String, String)
forall a. Eq a => [a] -> [a] -> ([a], [a])
breakOn String
x String
y = (String
a,String
b)
              | Bool
otherwise = String -> (String, String)
forall a. Partial => String -> a
error (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ "splitPair does not contain separator " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ " in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
y

joinPair :: [a] -> ([a], [a]) -> [a]
joinPair :: [a] -> ([a], [a]) -> [a]
joinPair sep :: [a]
sep (a :: [a]
a,b :: [a]
b) = [a]
a [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
sep [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
b

testing_, testing :: String -> IO () -> IO ()
testing_ :: String -> IO () -> IO ()
testing_ name :: String
name act :: IO ()
act = do String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Test " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ " "; IO ()
act
testing :: String -> IO () -> IO ()
testing name :: String
name act :: IO ()
act = do String -> IO () -> IO ()
testing_ String
name IO ()
act; String -> IO ()
putStrLn ""

testEq :: (Show a, Eq a) => a -> a -> IO ()
testEq :: a -> a -> IO ()
testEq a :: a
a b :: a
b | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b = String -> IO ()
putStr "."
           | Bool
otherwise = String -> IO ()
forall a. Partial => String -> IO a
errorIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Expected equal, but " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ " /= " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
b

showUTCTime :: String -> UTCTime -> String
showUTCTime :: String -> UTCTime -> String
showUTCTime = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale


withs :: [(a -> r) -> r] -> ([a] -> r) -> r
withs :: [(a -> r) -> r] -> ([a] -> r) -> r
withs [] act :: [a] -> r
act = [a] -> r
act []
withs (f :: (a -> r) -> r
f:fs :: [(a -> r) -> r]
fs) act :: [a] -> r
act = (a -> r) -> r
f ((a -> r) -> r) -> (a -> r) -> r
forall a b. (a -> b) -> a -> b
$ \a :: 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
$ \as :: [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


prettyTable :: Int -> String -> [(String, Double)] -> [String]
prettyTable :: Int -> String -> [(String, Double)] -> [String]
prettyTable dp :: Int
dp units :: String
units xs :: [(String, Double)]
xs =
    ( Int -> String -> String
padR Int
len String
units String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\tPercent\tName") String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
    [ Int -> String -> String
padL Int
len (Int -> Double -> String
forall a. RealFloat a => Int -> a -> String
showDP Int
dp Double
b) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\t" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
padL 7 (Int -> Double -> String
forall a. RealFloat a => Int -> a -> String
showDP 1 (100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
tot) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "%") String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\t" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a
    | (a :: String
a,b :: Double
b) <- ("Total", Double
tot) (String, Double) -> [(String, Double)] -> [(String, Double)]
forall a. a -> [a] -> [a]
: ((String, Double) -> Double)
-> [(String, Double)] -> [(String, Double)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Double -> Double
forall a. Num a => a -> a
negate (Double -> Double)
-> ((String, Double) -> Double) -> (String, Double) -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Double) -> Double
forall a b. (a, b) -> b
snd) [(String, Double)]
xs]
    where
        tot :: Double
tot = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ ((String, Double) -> Double) -> [(String, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (String, Double) -> Double
forall a b. (a, b) -> b
snd [(String, Double)]
xs
        len :: Int
len = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
units Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> Double -> String
forall a. RealFloat a => Int -> a -> String
showDP Int
dp Double
tot)

        padL :: Int -> String -> String
padL n :: Int
n s :: String
s = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) ' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
        padR :: Int -> String -> String
padR n :: Int
n s :: String
s = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) ' '

-- ensure that no value escapes in a thunk from the value
strict :: NFData a => IO a -> IO a
strict :: IO a -> IO a
strict act :: IO a
act = do
    Either SomeException a
res <- IO a -> IO (Either SomeException a)
forall a. IO a -> IO (Either SomeException a)
try_ IO a
act
    case Either SomeException a
res of
        Left e :: SomeException
e -> do String
msg <- SomeException -> IO String
forall e. Show e => e -> IO String
showException SomeException
e; () -> IO ()
forall a. a -> IO a
evaluate (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ()
forall a. NFData a => a -> ()
rnf String
msg; String -> IO a
forall a. Partial => String -> IO a
errorIO String
msg
        Right v :: a
v -> a -> IO a
forall a. a -> IO a
evaluate (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. NFData a => a -> a
force a
v

data Average a = Average !a {-# UNPACK #-} !Int deriving Int -> Average a -> String -> String
[Average a] -> String -> String
Average a -> String
(Int -> Average a -> String -> String)
-> (Average a -> String)
-> ([Average a] -> String -> String)
-> Show (Average a)
forall a. Show a => Int -> Average a -> String -> String
forall a. Show a => [Average a] -> String -> String
forall a. Show a => Average a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Average a] -> String -> String
$cshowList :: forall a. Show a => [Average a] -> String -> String
show :: Average a -> String
$cshow :: forall a. Show a => Average a -> String
showsPrec :: Int -> Average a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> Average a -> String -> String
Show -- a / b

toAverage :: a -> Average a
toAverage :: a -> Average a
toAverage x :: a
x = a -> Int -> Average a
forall a. a -> Int -> Average a
Average a
x 1

fromAverage :: Fractional a => Average a -> a
fromAverage :: Average a -> a
fromAverage (Average a :: a
a b :: Int
b) = a
a a -> a -> a
forall a. Fractional a => a -> a -> a
/ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b

instance Num a => Semigroup (Average a) where
    Average x1 :: a
x1 x2 :: Int
x2 <> :: Average a -> Average a -> Average a
<> Average y1 :: a
y1 y2 :: Int
y2 = a -> Int -> Average a
forall a. a -> Int -> Average a
Average (a
x1a -> a -> a
forall a. Num a => a -> a -> a
+a
y1) (Int
x2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
y2)

instance Num a => Monoid (Average a) where
    mempty :: Average a
mempty = a -> Int -> Average a
forall a. a -> Int -> Average a
Average 0 0
    mappend :: Average a -> Average a -> Average a
mappend = Average a -> Average a -> Average a
forall a. Semigroup a => a -> a -> a
(<>)


data TakeSort k v = More !Int !(Map.Map k [v])
                  | Full !k !(Map.Map k [v])

-- | @takeSortOn n op == take n . sortOn op@
takeSortOn :: Ord k => (a -> k) -> Int -> [a] -> [a]
takeSortOn :: (a -> k) -> Int -> [a] -> [a]
takeSortOn op :: a -> k
op n :: Int
n xs :: [a]
xs
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = []
    | Bool
otherwise = ([a] -> [a]) -> [[a]] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [a] -> [a]
forall a. [a] -> [a]
reverse ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ Map k [a] -> [[a]]
forall k a. Map k a -> [a]
Map.elems (Map k [a] -> [[a]]) -> Map k [a] -> [[a]]
forall a b. (a -> b) -> a -> b
$ TakeSort k a -> Map k [a]
forall k v. TakeSort k v -> Map k [v]
getMap (TakeSort k a -> Map k [a]) -> TakeSort k a -> Map k [a]
forall a b. (a -> b) -> a -> b
$ (TakeSort k a -> a -> TakeSort k a)
-> TakeSort k a -> [a] -> TakeSort k a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' TakeSort k a -> a -> TakeSort k a
add (Int -> Map k [a] -> TakeSort k a
forall k v. Int -> Map k [v] -> TakeSort k v
More Int
n Map k [a]
forall k a. Map k a
Map.empty) [a]
xs
    where
        getMap :: TakeSort k v -> Map k [v]
getMap (More _ mp :: Map k [v]
mp) = Map k [v]
mp
        getMap (Full _ mp :: Map k [v]
mp) = Map k [v]
mp

        add :: TakeSort k a -> a -> TakeSort k a
add (More n :: Int
n mp :: Map k [a]
mp) x :: a
x = (if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 1 then Map k [a] -> TakeSort k a
forall k v. Map k [v] -> TakeSort k v
full else Int -> Map k [a] -> TakeSort k a
forall k v. Int -> Map k [v] -> TakeSort k v
More (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)) (Map k [a] -> TakeSort k a) -> Map k [a] -> TakeSort k a
forall a b. (a -> b) -> a -> b
$ ([a] -> [a] -> [a]) -> k -> [a] -> Map k [a] -> Map k [a]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) (a -> k
op a
x) [a
x] Map k [a]
mp
        add o :: TakeSort k a
o@(Full mx :: k
mx mp :: Map k [a]
mp) x :: a
x = let k :: k
k = a -> k
op a
x in if k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
>= k
mx then TakeSort k a
o else Map k [a] -> TakeSort k a
forall k v. Map k [v] -> TakeSort k v
full (Map k [a] -> TakeSort k a) -> Map k [a] -> TakeSort k a
forall a b. (a -> b) -> a -> b
$ ([a] -> [a] -> [a]) -> k -> [a] -> Map k [a] -> Map k [a]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) k
k [a
x] (Map k [a] -> Map k [a]) -> Map k [a] -> Map k [a]
forall a b. (a -> b) -> a -> b
$ Map k [a] -> Map k [a]
forall k a. Ord k => Map k [a] -> Map k [a]
delMax Map k [a]
mp
        full :: Map k [v] -> TakeSort k v
full mp :: Map k [v]
mp = k -> Map k [v] -> TakeSort k v
forall k v. k -> Map k [v] -> TakeSort k v
Full ((k, [v]) -> k
forall a b. (a, b) -> a
fst ((k, [v]) -> k) -> (k, [v]) -> k
forall a b. (a -> b) -> a -> b
$ Map k [v] -> (k, [v])
forall k a. Map k a -> (k, a)
Map.findMax Map k [v]
mp) Map k [v]
mp
        delMax :: Map k [a] -> Map k [a]
delMax mp :: Map k [a]
mp | Just ((k :: k
k,_:vs :: [a]
vs), mp :: Map k [a]
mp) <- Map k [a] -> Maybe ((k, [a]), Map k [a])
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.maxViewWithKey Map k [a]
mp = if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
vs then Map k [a]
mp else k -> [a] -> Map k [a] -> Map k [a]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k [a]
vs Map k [a]
mp



-- 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' cmp :: 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
$ \x :: a
x y :: 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

minimumBy' :: (a -> a -> Ordering) -> [a] -> a
minimumBy' :: (a -> a -> Ordering) -> [a] -> a
minimumBy' cmp :: 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
$ \x :: a
x y :: a
y -> if a -> a -> Ordering
cmp a
x a
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then a
x else a
y

minimum' :: Ord a => [a] -> a
minimum' :: [a] -> a
minimum' = (a -> a -> Ordering) -> [a] -> a
forall a. (a -> a -> Ordering) -> [a] -> a
minimumBy' a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare


hackagePackageURL :: PkgName -> URL
hackagePackageURL :: PkgName -> String
hackagePackageURL x :: PkgName
x = "https://hackage.haskell.org/package/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PkgName -> String
strUnpack PkgName
x

hackageModuleURL :: ModName -> URL
hackageModuleURL :: PkgName -> String
hackageModuleURL x :: PkgName
x = "/docs/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PkgName -> String
ghcModuleURL PkgName
x

ghcModuleURL :: ModName -> URL
ghcModuleURL :: PkgName -> String
ghcModuleURL x :: PkgName
x = String -> String -> String -> String
forall a. (Partial, Eq a) => [a] -> [a] -> [a] -> [a]
replace "." "-" (PkgName -> String
strUnpack PkgName
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".html"

hackageDeclURL :: Bool -> String -> URL
hackageDeclURL :: Bool -> String -> String
hackageDeclURL typesig :: Bool
typesig x :: String
x = "#" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if Bool
typesig then "v" else "t") String -> String -> String
forall a. [a] -> [a] -> [a]
++ ":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
f String
x
    where
        f :: Char -> String
f x :: Char
x | Char -> Bool
isLegal Char
x = [Char
x]
            | Bool
otherwise = "-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Char -> Int
ord Char
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "-"
        -- isLegal is from haddock-api:Haddock.Utils; we need to use
        -- the same escaping strategy here in order for fragment links
        -- to work
        isLegal :: Char -> Bool
isLegal ':' = Bool
True
        isLegal '_' = Bool
True
        isLegal '.' = Bool
True
        isLegal c :: Char
c = Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c


trimVersion :: Int -> Version -> Version
trimVersion :: Int -> Version -> Version
trimVersion i :: Int
i v :: Version
v = Version
v{versionBranch :: [Int]
versionBranch = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take 3 ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Version -> [Int]
versionBranch Version
v}

parseTrailingVersion :: String -> (String, [Int])
parseTrailingVersion :: String -> (String, [Int])
parseTrailingVersion = (String -> String
forall a. [a] -> [a]
reverse (String -> String)
-> ([Int] -> [Int]) -> (String, [Int]) -> (String, [Int])
forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
*** [Int] -> [Int]
forall a. [a] -> [a]
reverse) ((String, [Int]) -> (String, [Int]))
-> (String -> (String, [Int])) -> String -> (String, [Int])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, [Int])
forall a. Read a => String -> (String, [a])
f (String -> (String, [Int]))
-> (String -> String) -> String -> (String, [Int])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
    where
        f :: String -> (String, [a])
f xs :: String
xs | (ver :: String
ver@(_:_),sep :: Char
sep:xs :: String
xs) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
xs
             , Char
sep Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-' Bool -> Bool -> Bool
|| Char
sep Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.'
             , (a :: String
a, b :: [a]
b) <- String -> (String, [a])
f String
xs
             = (String
a, String -> a
forall a. Read a => String -> a
Prelude.read (String -> String
forall a. [a] -> [a]
reverse String
ver) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
b)
        f xs :: String
xs = (String
xs, [])


-- | Equivalent to any (`inRange` x) xs, but more efficient
inRanges :: Ix a => [(a,a)] -> (a -> Bool)
inRanges :: [(a, a)] -> a -> Bool
inRanges xs :: [(a, a)]
xs = \x :: a
x -> Bool -> ((a, a) -> Bool) -> Maybe (a, a) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((a, a) -> a -> Bool
forall a. Ix a => (a, a) -> a -> Bool
`inRange` a
x) (Maybe (a, a) -> Bool) -> Maybe (a, a) -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Map a a -> Maybe (a, a)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE a
x Map a a
mp
    where
        mp :: Map a a
mp = (Map a a -> (a, a) -> Map a a) -> Map a a -> [(a, a)] -> Map a a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map a a -> (a, a) -> Map a a
forall a. Ix a => Map a a -> (a, a) -> Map a a
add Map a a
forall k a. Map k a
Map.empty [(a, a)]
xs

        merge :: (a, b) -> (a, b) -> (a, b)
merge (l1 :: a
l1,u1 :: b
u1) (l2 :: a
l2,u2 :: b
u2) = (a -> a -> a
forall a. Ord a => a -> a -> a
min a
l1 a
l2, b -> b -> b
forall a. Ord a => a -> a -> a
max b
u1 b
u2)
        overlap :: (b, b) -> (b, b) -> Bool
overlap x1 :: (b, b)
x1 x2 :: (b, b)
x2 = (b, b)
x1 (b, b) -> b -> Bool
forall a. Ix a => (a, a) -> a -> Bool
`inRange` (b, b) -> b
forall a b. (a, b) -> a
fst (b, b)
x2 Bool -> Bool -> Bool
|| (b, b)
x2 (b, b) -> b -> Bool
forall a. Ix a => (a, a) -> a -> Bool
`inRange` (b, b) -> b
forall a b. (a, b) -> a
fst (b, b)
x1
        add :: Map a a -> (a, a) -> Map a a
add mp :: Map a a
mp x :: (a, a)
x
            | Just x2 :: (a, a)
x2 <- a -> Map a a -> Maybe (a, a)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE ((a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
x) Map a a
mp, (a, a) -> (a, a) -> Bool
forall b. Ix b => (b, b) -> (b, b) -> Bool
overlap (a, a)
x (a, a)
x2 = Map a a -> (a, a) -> Map a a
add (a -> Map a a -> Map a a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete ((a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
x2) Map a a
mp) ((a, a) -> (a, a) -> (a, a)
forall a b. (Ord a, Ord b) => (a, b) -> (a, b) -> (a, b)
merge (a, a)
x (a, a)
x2)
            | Just x2 :: (a, a)
x2 <- a -> Map a a -> Maybe (a, a)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupGE ((a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
x) Map a a
mp, (a, a) -> (a, a) -> Bool
forall b. Ix b => (b, b) -> (b, b) -> Bool
overlap (a, a)
x (a, a)
x2 = Map a a -> (a, a) -> Map a a
add (a -> Map a a -> Map a a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete ((a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
x2) Map a a
mp) ((a, a) -> (a, a) -> (a, a)
forall a b. (Ord a, Ord b) => (a, b) -> (a, b) -> (a, b)
merge (a, a)
x (a, a)
x2)
            | Bool
otherwise = (a -> a -> Map a a -> Map a a) -> (a, a) -> Map a a -> Map a a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> Map a a -> Map a a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (a, a)
x Map a a
mp


general_util_test :: IO ()
general_util_test :: IO ()
general_util_test = do
    String -> IO () -> IO ()
testing "General.Util.splitPair" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        let a :: b
a === :: b -> b -> IO ()
=== b :: b
b = if b
a b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
b then Char -> IO ()
putChar '.' else String -> IO ()
forall a. Partial => String -> IO a
errorIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ (b, b) -> String
forall a. Show a => a -> String
show (b
a,b
b)
        String -> String -> (String, String)
splitPair ":" "module:foo:bar" (String, String) -> (String, String) -> IO ()
forall b. (Eq b, Show b) => b -> b -> IO ()
=== ("module","foo:bar")
        do Either SomeException ()
x <- IO () -> IO (Either SomeException ())
forall a. IO a -> IO (Either SomeException a)
try_ (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
evaluate (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ (String, String) -> ()
forall a. NFData a => a -> ()
rnf ((String, String) -> ()) -> (String, String) -> ()
forall a b. (a -> b) -> a -> b
$ String -> String -> (String, String)
splitPair "-" "module:foo"; Either SomeException () -> Bool
forall a b. Either a b -> Bool
isLeft Either SomeException ()
x Bool -> Bool -> IO ()
forall b. (Eq b, Show b) => b -> b -> IO ()
=== Bool
True
        String -> String -> (String, String)
splitPair "-" "module-" (String, String) -> (String, String) -> IO ()
forall b. (Eq b, Show b) => b -> b -> IO ()
=== ("module","")
    String -> IO () -> IO ()
testing_ "General.Util.inRanges" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (Int8 -> [(Int8, Int8)] -> Bool) -> IO ()
forall prop. Testable prop => prop -> IO ()
quickCheck ((Int8 -> [(Int8, Int8)] -> Bool) -> IO ())
-> (Int8 -> [(Int8, Int8)] -> Bool) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int8
x :: Int8) xs :: [(Int8, Int8)]
xs -> [(Int8, Int8)] -> Int8 -> Bool
forall a. Ix a => [(a, a)] -> a -> Bool
inRanges [(Int8, Int8)]
xs Int8
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== ((Int8, Int8) -> Bool) -> [(Int8, Int8)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Int8, Int8) -> Int8 -> Bool
forall a. Ix a => (a, a) -> a -> Bool
`inRange` Int8
x) [(Int8, Int8)]
xs
    String -> IO () -> IO ()
testing "General.Util.parseTrailingVersion" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        let a :: b
a === :: b -> b -> IO ()
=== b :: b
b = if b
a b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
b then Char -> IO ()
putChar '.' else String -> IO ()
forall a. Partial => String -> IO a
errorIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ (b, b) -> String
forall a. Show a => a -> String
show (b
a,b
b)
        String -> (String, [Int])
parseTrailingVersion "shake-0.15.2" (String, [Int]) -> (String, [Int]) -> IO ()
forall b. (Eq b, Show b) => b -> b -> IO ()
=== ("shake",[0,15,2])
        String -> (String, [Int])
parseTrailingVersion "test-of-stuff1" (String, [Int]) -> (String, [Int]) -> IO ()
forall b. (Eq b, Show b) => b -> b -> IO ()
=== ("test-of-stuff1",[])