{-# 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 a
x = a -> String
forall a. Show a => a -> String
show (a
x a -> a -> a
forall a. Integral a => a -> a -> a
`div` (a
1024a -> a -> a
forall a. Num a => a -> a -> a
*a
1024)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Mb"
#else
showMb x = show x ++ "Mb"
#endif


#if RTS_STATS
withRTSStats :: (RTSStats -> a) -> IO (Maybe a)
withRTSStats :: (RTSStats -> a) -> IO (Maybe a)
withRTSStats 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 String
", " String
"\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
/= Char
'}') (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
/= Char
'{') (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 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 Type a
x (Type a
t:[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 Type a
x [] = Type a
x

applyFun1 :: [Type a] -> Type a
applyFun1 :: [Type a] -> Type a
applyFun1 [Type a
x] = Type a
x
applyFun1 (Type a
x:[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 a
_ Type a
x 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 Type a
x = [Type a
x]


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

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

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

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

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

fromDeclHead :: DeclHead a -> (Name a, [TyVarBind a])
fromDeclHead :: DeclHead a -> (Name a, [TyVarBind a])
fromDeclHead (DHead a
_ Name a
n) = (Name a
n, [])
fromDeclHead (DHInfix a
_ TyVarBind a
x Name a
n) = (Name a
n, [TyVarBind a
x])
fromDeclHead (DHParen a
_ DeclHead a
x) = DeclHead a -> (Name a, [TyVarBind a])
forall a. DeclHead a -> (Name a, [TyVarBind a])
fromDeclHead DeclHead a
x
fromDeclHead (DHApp a
_ DeclHead a
dh 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 a
_ QName a
n) = (QName a
n, [])
fromInstHead (IHInfix a
_ Type a
x QName a
n) = (QName a
n, [Type a
x])
fromInstHead (IHParen a
_ InstHead a
x) = InstHead a -> (QName a, [Type a])
forall a. InstHead a -> (QName a, [Type a])
fromInstHead InstHead a
x
fromInstHead (IHApp a
_ InstHead a
ih 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 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 a
_ DeclHead a
hd Type a
_ -> DeclHead a -> [Name a]
forall a. DeclHead a -> [Name a]
f DeclHead a
hd
    DataDecl a
_ DataOrNew a
_ Maybe (Context a)
_ DeclHead a
hd [QualConDecl a]
_ [Deriving a]
_ -> DeclHead a -> [Name a]
forall a. DeclHead a -> [Name a]
f DeclHead a
hd
    GDataDecl a
_ DataOrNew a
_ Maybe (Context a)
_ DeclHead a
hd Maybe (Type a)
_ [GadtDecl a]
_ [Deriving a]
_ -> DeclHead a -> [Name a]
forall a. DeclHead a -> [Name a]
f DeclHead a
hd
    TypeFamDecl a
_ DeclHead a
hd Maybe (ResultSig a)
_ Maybe (InjectivityInfo a)
_ -> DeclHead a -> [Name a]
forall a. DeclHead a -> [Name a]
f DeclHead a
hd
    DataFamDecl a
_ Maybe (Context a)
_ DeclHead a
hd Maybe (ResultSig a)
_ -> DeclHead a -> [Name a]
forall a. DeclHead a -> [Name a]
f DeclHead a
hd
    ClassDecl a
_ Maybe (Context a)
_ DeclHead a
hd [FunDep a]
_ Maybe [ClassDecl a]
_ -> DeclHead a -> [Name a]
forall a. DeclHead a -> [Name a]
f DeclHead a
hd
    TypeSig a
_ [Name a]
names Type a
_ -> [Name a]
names
    PatSynSig a
_ [Name a]
names Maybe [TyVarBind a]
_ Maybe (Context a)
_ Maybe [TyVarBind a]
_ Maybe (Context a)
_ Type a
_ -> [Name a]
names
    Decl a
_ -> []
    where f :: DeclHead a -> [Name a]
f 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 Decl a
_ = Bool
False


tarballReadFiles :: FilePath -> IO [(FilePath, LBS.ByteString)]
tarballReadFiles :: String -> IO [(String, ByteString)]
tarballReadFiles 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 Entry
e Entries a
rest) | NormalFile ByteString
body FileSize
_ <- 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 Entry
_ Entries a
rest) = Entries a -> [(String, ByteString)]
f Entries a
rest
        f Entries a
Done = []
        f (Fail a
e) = String -> [(String, ByteString)]
forall a. Partial => String -> a
error (String -> [(String, ByteString)])
-> String -> [(String, ByteString)]
forall a b. (a -> b) -> a -> b
$ String
"tarballReadFiles on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " 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 (Char
'<':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
/= Char
'>') String
xs
innerTextHTML (Char
x: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 (Char
x:String
xs) = Char -> Bool
isUpper Char
x
isUpper1 String
_ = Bool
False

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

splitPair :: String -> String -> (String, String)
splitPair :: String -> String -> (String, String)
splitPair String
x String
y | (String
a,String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
x -> Just 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
$ String
"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]
++ String
" 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 [a]
sep ([a]
a,[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_ String
name IO ()
act = do String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Test " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "; IO ()
act
testing :: String -> IO () -> IO ()
testing String
name IO ()
act = do String -> IO () -> IO ()
testing_ String
name IO ()
act; String -> IO ()
putStrLn String
""

testEq :: (Show a, Eq a) => a -> a -> IO ()
testEq :: a -> a -> IO ()
testEq a
a a
b | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b = String -> IO ()
putStr String
"."
           | Bool
otherwise = String -> IO ()
forall a. Partial => String -> IO a
errorIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"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 -> 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 [] [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


prettyTable :: Int -> String -> [(String, Double)] -> [String]
prettyTable :: Int -> String -> [(String, Double)] -> [String]
prettyTable Int
dp String
units [(String, Double)]
xs =
    ( Int -> String -> String
padR Int
len String
units String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\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]
++ String
"\t" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
padL Int
7 (Int -> Double -> String
forall a. RealFloat a => Int -> a -> String
showDP Int
1 (Double
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 -> String
forall a. [a] -> [a] -> [a]
++ String
"\t" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a
    | (String
a,Double
b) <- (String
"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 Int
n 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) Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
        padR :: Int -> String -> String
padR Int
n 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) Char
' '

-- ensure that no value escapes in a thunk from the value
strict :: NFData a => IO a -> IO a
strict :: IO a -> IO a
strict 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 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 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 a
x = a -> Int -> Average a
forall a. a -> Int -> Average a
Average a
x Int
1

fromAverage :: Fractional a => Average a -> a
fromAverage :: Average a -> a
fromAverage (Average a
a 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 a
x1 Int
x2 <> :: Average a -> Average a -> Average a
<> Average a
y1 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 a
0 Int
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 a -> k
op Int
n [a]
xs
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
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 Int
_ Map k [v]
mp) = Map k [v]
mp
        getMap (Full k
_ Map k [v]
mp) = Map k [v]
mp

        add :: TakeSort k a -> a -> TakeSort k a
add (More Int
n Map k [a]
mp) a
x = (if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
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
-Int
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 k
mx Map k [a]
mp) 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 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 Map k [a]
mp | Just ((k
k,a
_:[a]
vs), 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' 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

minimumBy' :: (a -> a -> Ordering) -> [a] -> a
minimumBy' :: (a -> a -> Ordering) -> [a] -> a
minimumBy' 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
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 PkgName
x = String
"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 PkgName
x = String
"/docs/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PkgName -> String
ghcModuleURL PkgName
x

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

hackageDeclURL :: Bool -> String -> URL
hackageDeclURL :: Bool -> String -> String
hackageDeclURL Bool
typesig String
x = String
"#" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if Bool
typesig then String
"v" else String
"t") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" 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 Char
x | Char -> Bool
isLegal Char
x = [Char
x]
            | Bool
otherwise = String
"-" 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]
++ String
"-"
        -- 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 Char
':' = Bool
True
        isLegal Char
'_' = Bool
True
        isLegal Char
'.' = Bool
True
        isLegal Char
c = Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c


trimVersion :: Int -> Version -> Version
trimVersion :: Int -> Version -> Version
trimVersion Int
i Version
v = Version
v{versionBranch :: [Int]
versionBranch = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
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 String
xs | (ver :: String
ver@(Char
_:String
_),Char
sep: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
== Char
'-' Bool -> Bool -> Bool
|| Char
sep Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'
             , (String
a, [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 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 [(a, a)]
xs = \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 (a
l1,b
u1) (a
l2,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 (b, b)
x1 (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 Map a a
mp (a, a)
x
            | Just (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 (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 String
"General.Util.splitPair" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        let b
a === :: b -> b -> IO ()
=== b
b = if b
a b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
b then Char -> IO ()
putChar Char
'.' 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 String
":" String
"module:foo:bar" (String, String) -> (String, String) -> IO ()
forall b. (Eq b, Show b) => b -> b -> IO ()
=== (String
"module",String
"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 String
"-" String
"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 String
"-" String
"module-" (String, String) -> (String, String) -> IO ()
forall b. (Eq b, Show b) => b -> b -> IO ()
=== (String
"module",String
"")
    String -> IO () -> IO ()
testing_ String
"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) [(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 String
"General.Util.parseTrailingVersion" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        let b
a === :: b -> b -> IO ()
=== b
b = if b
a b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
b then Char -> IO ()
putChar Char
'.' 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 String
"shake-0.15.2" (String, [Int]) -> (String, [Int]) -> IO ()
forall b. (Eq b, Show b) => b -> b -> IO ()
=== (String
"shake",[Int
0,Int
15,Int
2])
        String -> (String, [Int])
parseTrailingVersion String
"test-of-stuff1" (String, [Int]) -> (String, [Int]) -> IO ()
forall b. (Eq b, Show b) => b -> b -> IO ()
=== (String
"test-of-stuff1",[])