{-# LANGUAGE QuantifiedConstraints #-}
module Test.Cleveland.Util
( leftToShowPanic
, (?-)
, failedTest
, succeededTest
, eitherIsLeft
, eitherIsRight
, meanTimeUpperBoundProp
, meanTimeUpperBoundPropNF
, genTuple2
, genRandom
, runGen
, roundtripTree
, assertGoesBefore
, goesBefore
, formatValue
, formatSomeValue
, ShowWith(..)
, Showing(..)
, ceilingUnit
, timeToFixed
, timeToNominalDiffTime
, stripOptional0x
, fromHex
, parseAddressFromHex
, mapEach
, forEach
, mcs, ms, sec, minute
) where
import Debug qualified (show)
import Control.Lens qualified as L
import Control.Monad.Random (MonadRandom, evalRand, mkStdGen)
import Criterion (Benchmarkable, benchmarkWith', nf, whnf)
import Criterion.Main (defaultConfig)
import Criterion.Types (SampleAnalysis(anMean), Verbosity(Quiet), reportAnalysis, verbosity)
import Data.Fixed (Fixed, HasResolution)
import Data.Ratio ((%))
import Data.Singletons (demote)
import Data.Text qualified as T
import Data.Time (NominalDiffTime, secondsToNominalDiffTime)
import Data.Typeable (typeRep)
import Fmt (Buildable, Builder, build, pretty, (+|), (|+))
import Hedgehog
(Gen, MonadGen, MonadTest, Property, annotate, evalIO, failure, forAll, property, success,
tripping, withTests)
import Hedgehog.Gen qualified as Gen
import Hedgehog.Internal.Gen (runGenT)
import Hedgehog.Internal.Seed qualified as Seed
import Hedgehog.Internal.Tree (TreeT(runTreeT), nodeValue)
import Hedgehog.Range qualified as Range
import Statistics.Types (Estimate(estPoint))
import Test.HUnit (Assertion, assertFailure)
import Test.Tasty (TestTree)
import Test.Tasty.HUnit (testCase)
import Test.Tasty.Hedgehog (testProperty)
import Text.Hex (decodeHex)
import Text.Printf (printf)
import Text.Show qualified
import Time
(KnownDivRat, KnownUnitName, Microsecond, Millisecond, Minute, Nanosecond, Picosecond, Rat,
RatioNat, Second, Time, mcs, minute, ms, ns, sec, time, timeout, toUnit, unTime, unitNameVal)
import Morley.Michelson.Doc (DocItem, docItemPosition)
import Morley.Michelson.Typed (SingI, SomeConstrainedValue)
import Morley.Michelson.Typed qualified as T
import Morley.Tezos.Address
import Morley.Util.Constrained
import Test.Cleveland.Instances ()
leftToShowPanic :: (PrettyShow e, Show e, HasCallStack) => Either e a -> a
leftToShowPanic :: forall e a. (PrettyShow e, Show e, HasCallStack) => Either e a -> a
leftToShowPanic = (e -> a) -> (a -> a) -> Either e a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> a
forall a. HasCallStack => Text -> a
error (Text -> a) -> (e -> Text) -> e -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show) a -> a
forall a. a -> a
id
(?-) :: Text -> a -> (Text, a)
?- :: forall a. Text -> a -> (Text, a)
(?-) = (,)
infixr 0 ?-
failedTest :: (HasCallStack, MonadTest m) => Text -> m ()
failedTest :: forall (m :: * -> *). (HasCallStack, MonadTest m) => Text -> m ()
failedTest Text
r =
(HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
annotate (Text -> String
forall a. ToString a => a -> String
toString Text
r) m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m a
failure
succeededTest :: MonadTest m => m ()
succeededTest :: forall (m :: * -> *). MonadTest m => m ()
succeededTest = m ()
forall (m :: * -> *). MonadTest m => m ()
success
eitherIsLeft :: (Show b, MonadTest m, HasCallStack) => Either a b -> m ()
eitherIsLeft :: forall b (m :: * -> *) a.
(Show b, MonadTest m, HasCallStack) =>
Either a b -> m ()
eitherIsLeft = \case
Left a
_ -> m ()
forall (m :: * -> *). MonadTest m => m ()
succeededTest
Right b
x ->
(HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadTest m) => Text -> m ()
failedTest (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"expected Left, got Right (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> b -> Text
forall b a. (Show a, IsString b) => a -> b
Debug.show b
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
eitherIsRight :: (Show a, MonadTest m, HasCallStack) => Either a b -> m ()
eitherIsRight :: forall a (m :: * -> *) b.
(Show a, MonadTest m, HasCallStack) =>
Either a b -> m ()
eitherIsRight = \case
Right b
_ -> m ()
forall (m :: * -> *). MonadTest m => m ()
succeededTest
Left a
x ->
(HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadTest m) => Text -> m ()
failedTest (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"expected Right, got Left (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall b a. (Show a, IsString b) => a -> b
Debug.show a
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
meanTimeUpperBoundProp
:: (KnownDivRat unit Second, KnownUnitName unit, HasCallStack)
=> Time unit -> (a -> b) -> a -> Property
meanTimeUpperBoundProp :: forall (unit :: Rat) a b.
(KnownDivRat unit Second, KnownUnitName unit, HasCallStack) =>
Time unit -> (a -> b) -> a -> Property
meanTimeUpperBoundProp Time unit
upperBound a -> b
run a
arg =
(HasCallStack => Property) -> Property
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Property) -> Property)
-> (HasCallStack => Property) -> Property
forall a b. (a -> b) -> a -> b
$
Time unit -> Benchmarkable -> Property
forall (unit :: Rat).
(KnownDivRat unit Second, KnownUnitName unit, HasCallStack) =>
Time unit -> Benchmarkable -> Property
checkReport Time unit
upperBound (Benchmarkable -> Property) -> Benchmarkable -> Property
forall a b. (a -> b) -> a -> b
$ (a -> b) -> a -> Benchmarkable
forall a b. (a -> b) -> a -> Benchmarkable
whnf a -> b
run a
arg
meanTimeUpperBoundPropNF
:: (KnownDivRat unit Second, KnownUnitName unit, HasCallStack, NFData b)
=> Time unit -> (a -> b) -> a -> Property
meanTimeUpperBoundPropNF :: forall (unit :: Rat) b a.
(KnownDivRat unit Second, KnownUnitName unit, HasCallStack,
NFData b) =>
Time unit -> (a -> b) -> a -> Property
meanTimeUpperBoundPropNF Time unit
upperBound a -> b
run a
arg =
(HasCallStack => Property) -> Property
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Property) -> Property)
-> (HasCallStack => Property) -> Property
forall a b. (a -> b) -> a -> b
$
Time unit -> Benchmarkable -> Property
forall (unit :: Rat).
(KnownDivRat unit Second, KnownUnitName unit, HasCallStack) =>
Time unit -> Benchmarkable -> Property
checkReport Time unit
upperBound (Benchmarkable -> Property) -> Benchmarkable -> Property
forall a b. (a -> b) -> a -> b
$ (a -> b) -> a -> Benchmarkable
forall b a. NFData b => (a -> b) -> a -> Benchmarkable
nf a -> b
run a
arg
checkReport
:: (KnownDivRat unit Second, KnownUnitName unit)
=> HasCallStack => Time unit -> Benchmarkable -> Property
checkReport :: forall (unit :: Rat).
(KnownDivRat unit Second, KnownUnitName unit, HasCallStack) =>
Time unit -> Benchmarkable -> Property
checkReport Time unit
upperBound Benchmarkable
benchmarkable =
TestLimit -> Property -> Property
withTests TestLimit
1 (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$
IO (Maybe Report) -> PropertyT IO (Maybe Report)
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
evalIO IO (Maybe Report)
runBench PropertyT IO (Maybe Report)
-> (Maybe Report -> PropertyT IO ()) -> PropertyT IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Report
Nothing -> Text -> PropertyT IO ()
forall (m :: * -> *). (HasCallStack, MonadTest m) => Text -> m ()
failedTest Text
"Expected benchmark to complete within 120 seconds."
Just Report
report ->
let mean :: Time (1 :% 1)
mean = RatioNat -> Time (1 :% 1)
RatioNat -> Time Second
sec (RatioNat -> Time (1 :% 1))
-> (SampleAnalysis -> RatioNat) -> SampleAnalysis -> Time (1 :% 1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Real a, Fractional b) => a -> b
realToFrac @Double @RatioNat (Double -> RatioNat)
-> (SampleAnalysis -> Double) -> SampleAnalysis -> RatioNat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate ConfInt Double -> Double
forall (e :: * -> *) a. Estimate e a -> a
estPoint (Estimate ConfInt Double -> Double)
-> (SampleAnalysis -> Estimate ConfInt Double)
-> SampleAnalysis
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SampleAnalysis -> Estimate ConfInt Double
anMean (SampleAnalysis -> Time (1 :% 1))
-> SampleAnalysis -> Time (1 :% 1)
forall a b. (a -> b) -> a -> b
$ Report -> SampleAnalysis
reportAnalysis Report
report
in if Time (1 :% 1)
mean Time (1 :% 1) -> Time (1 :% 1) -> Bool
forall a. Ord a => a -> a -> Bool
< forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Second Time unit
upperBound
then PropertyT IO ()
forall (m :: * -> *). MonadTest m => m ()
succeededTest
else Text -> PropertyT IO ()
forall (m :: * -> *). (HasCallStack, MonadTest m) => Text -> m ()
failedTest (Text -> PropertyT IO ()) -> Text -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$
Text
"Expected mean estimate to be under "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Time unit -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Time unit
upperBound
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", but was "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Time Second -> Text
display Time (1 :% 1)
Time Second
mean
where
runBench :: IO (Maybe Report)
runBench = Time (60 :% 1) -> IO Report -> IO (Maybe Report)
forall (unit :: Rat) (m :: * -> *) a.
(MonadIO m, KnownDivRat unit Microsecond) =>
Time unit -> IO a -> m (Maybe a)
timeout (RatioNat -> Time Minute
minute RatioNat
2) (IO Report -> IO (Maybe Report)) -> IO Report -> IO (Maybe Report)
forall a b. (a -> b) -> a -> b
$
Config -> Benchmarkable -> IO Report
benchmarkWith' (Config
defaultConfig { verbosity :: Verbosity
verbosity = Verbosity
Quiet }) Benchmarkable
benchmarkable
display :: Time Second -> Text
display :: Time Second -> Text
display Time Second
n = case Time Second
n of
(forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Minute -> Time Minute
x) | Time (60 :% 1)
Time Minute
x Time (60 :% 1) -> Time (60 :% 1) -> Bool
forall a. Ord a => a -> a -> Bool
> RatioNat -> Time Minute
minute RatioNat
1 -> Time (60 :% 1) -> Text
forall (unit :: Rat). KnownUnitName unit => Time unit -> Text
format Time (60 :% 1)
Time Minute
x
(forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Second -> Time Second
x) | Time (1 :% 1)
Time Second
x Time (1 :% 1) -> Time (1 :% 1) -> Bool
forall a. Ord a => a -> a -> Bool
> RatioNat -> Time Second
sec RatioNat
1 -> Time (1 :% 1) -> Text
forall (unit :: Rat). KnownUnitName unit => Time unit -> Text
format Time (1 :% 1)
Time Second
x
(forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Millisecond -> Time Millisecond
x) | Time (1 :% 1000)
Time Millisecond
x Time (1 :% 1000) -> Time (1 :% 1000) -> Bool
forall a. Ord a => a -> a -> Bool
> RatioNat -> Time Millisecond
ms RatioNat
1 -> Time (1 :% 1000) -> Text
forall (unit :: Rat). KnownUnitName unit => Time unit -> Text
format Time (1 :% 1000)
Time Millisecond
x
(forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Microsecond -> Time Microsecond
x) | Time (1 :% 1000000)
Time Microsecond
x Time (1 :% 1000000) -> Time (1 :% 1000000) -> Bool
forall a. Ord a => a -> a -> Bool
> RatioNat -> Time Microsecond
mcs RatioNat
1 -> Time (1 :% 1000000) -> Text
forall (unit :: Rat). KnownUnitName unit => Time unit -> Text
format Time (1 :% 1000000)
Time Microsecond
x
(forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Nanosecond -> Time Nanosecond
x) | Time (1 :% 1000000000)
Time Nanosecond
x Time (1 :% 1000000000) -> Time (1 :% 1000000000) -> Bool
forall a. Ord a => a -> a -> Bool
> RatioNat -> Time Nanosecond
ns RatioNat
1 -> Time (1 :% 1000000000) -> Text
forall (unit :: Rat). KnownUnitName unit => Time unit -> Text
format Time (1 :% 1000000000)
Time Nanosecond
x
Time Second
_ -> Time (1 :% 1000000000000) -> Text
forall (unit :: Rat). KnownUnitName unit => Time unit -> Text
format (forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Picosecond Time (1 :% 1)
Time Second
n)
format :: forall unit. KnownUnitName unit => Time unit -> Text
format :: forall (unit :: Rat). KnownUnitName unit => Time unit -> Text
format Time unit
n =
forall a. ToText a => a -> Text
toText @String (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Double -> String -> String
forall r. PrintfType r => String -> r
printf String
"%.4f%s"
(forall a b. (Real a, Fractional b) => a -> b
realToFrac @RatioNat @Double (RatioNat -> Double) -> RatioNat -> Double
forall a b. (a -> b) -> a -> b
$ Time unit -> RatioNat
forall (rat :: Rat). Time rat -> RatioNat
unTime Time unit
n)
(forall (unit :: Rat). KnownUnitName unit => String
unitNameVal @unit)
genTuple2 :: MonadGen m => m a -> m b -> m (a, b)
genTuple2 :: forall (m :: * -> *) a b. MonadGen m => m a -> m b -> m (a, b)
genTuple2 = (a -> b -> (a, b)) -> m a -> m b -> m (a, b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,)
genRandom :: MonadGen m => (forall n. MonadRandom n => n a) -> m a
genRandom :: forall (m :: * -> *) a.
MonadGen m =>
(forall (n :: * -> *). MonadRandom n => n a) -> m a
genRandom forall (n :: * -> *). MonadRandom n => n a
gen = Rand StdGen a -> StdGen -> a
forall g a. Rand g a -> g -> a
evalRand Rand StdGen a
forall (n :: * -> *). MonadRandom n => n a
gen (StdGen -> a) -> (Int -> StdGen) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> StdGen
mkStdGen (Int -> a) -> m Int -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Int -> m Int
forall (m :: * -> *) a. MonadGen m => m a -> m a
Gen.prune m Int
forall (m :: * -> *) a. (MonadGen m, Enum a, Bounded a) => m a
Gen.enumBounded
runGen :: HasCallStack => Range.Size -> Word64 -> Gen a -> a
runGen :: forall a. HasCallStack => Size -> Word64 -> Gen a -> a
runGen Size
size Word64
seed Gen a
genT =
let tree :: TreeT (MaybeT Identity) a
tree = Size -> Seed -> Gen a -> TreeT (MaybeT Identity) a
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size (Word64 -> Seed
Seed.from Word64
seed) Gen a
genT
node :: NodeT (MaybeT Identity) a
node = NodeT (MaybeT Identity) a
-> Maybe (NodeT (MaybeT Identity) a) -> NodeT (MaybeT Identity) a
forall a. a -> Maybe a -> a
fromMaybe NodeT (MaybeT Identity) a
discardedErr (Maybe (NodeT (MaybeT Identity) a) -> NodeT (MaybeT Identity) a)
-> Maybe (NodeT (MaybeT Identity) a) -> NodeT (MaybeT Identity) a
forall a b. (a -> b) -> a -> b
$ Identity (Maybe (NodeT (MaybeT Identity) a))
-> Maybe (NodeT (MaybeT Identity) a)
forall a. Identity a -> a
runIdentity (Identity (Maybe (NodeT (MaybeT Identity) a))
-> Maybe (NodeT (MaybeT Identity) a))
-> Identity (Maybe (NodeT (MaybeT Identity) a))
-> Maybe (NodeT (MaybeT Identity) a)
forall a b. (a -> b) -> a -> b
$ MaybeT Identity (NodeT (MaybeT Identity) a)
-> Identity (Maybe (NodeT (MaybeT Identity) a))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Identity (NodeT (MaybeT Identity) a)
-> Identity (Maybe (NodeT (MaybeT Identity) a)))
-> MaybeT Identity (NodeT (MaybeT Identity) a)
-> Identity (Maybe (NodeT (MaybeT Identity) a))
forall a b. (a -> b) -> a -> b
$ TreeT (MaybeT Identity) a
-> MaybeT Identity (NodeT (MaybeT Identity) a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT (MaybeT Identity) a
tree
discardedErr :: NodeT (MaybeT Identity) a
discardedErr = Text -> NodeT (MaybeT Identity) a
forall a. HasCallStack => Text -> a
error (Text -> NodeT (MaybeT Identity) a)
-> Text -> NodeT (MaybeT Identity) a
forall a b. (a -> b) -> a -> b
$
Text
"Generator could not produce a value for size "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show (Size -> Int
Range.unSize Size
size) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and seed " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Word64
seed
in NodeT (MaybeT Identity) a -> a
forall (m :: * -> *) a. NodeT m a -> a
nodeValue NodeT (MaybeT Identity) a
node
roundtripTree
:: forall x y err.
( Show x
, Show y
, Show err
, Typeable x
, Eq x
, Eq err
, HasCallStack
)
=> Gen x
-> (x -> y)
-> (y -> Either err x)
-> TestTree
roundtripTree :: forall x y err.
(Show x, Show y, Show err, Typeable x, Eq x, Eq err,
HasCallStack) =>
Gen x -> (x -> y) -> (y -> Either err x) -> TestTree
roundtripTree Gen x
genX x -> y
xToY y -> Either err x
yToX = String -> Property -> TestTree
testProperty String
typeNameX Property
prop
where
typeNameX :: String
typeNameX = TypeRep -> String
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy x -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @x)
prop :: Property
prop :: Property
prop = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
x
x <- Gen x -> PropertyT IO x
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen x
genX
x -> (x -> y) -> (y -> Either err x) -> PropertyT IO ()
forall (m :: * -> *) (f :: * -> *) b a.
(MonadTest m, Applicative f, Show b, Show (f a), Eq (f a),
HasCallStack) =>
a -> (a -> b) -> (b -> f a) -> m ()
tripping x
x x -> y
xToY y -> Either err x
yToX
assertGoesBefore
:: forall d1 d2.
(DocItem d1, DocItem d2)
=> Proxy d1 -> Proxy d2 -> Assertion
assertGoesBefore :: forall d1 d2.
(DocItem d1, DocItem d2) =>
Proxy d1 -> Proxy d2 -> Assertion
assertGoesBefore Proxy d1
dp1 Proxy d2
dp2 =
Bool -> Assertion -> Assertion
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (DocItemPos
p1 DocItemPos -> DocItemPos -> Bool
forall a. Ord a => a -> a -> Bool
< DocItemPos
p2) (Assertion -> Assertion) -> Assertion -> Assertion
forall a b. (a -> b) -> a -> b
$
String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String -> Assertion) -> String -> Assertion
forall a b. (a -> b) -> a -> b
$
String
"Doc item " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TypeRep -> String
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show (Proxy d1 -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy d1
dp1) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" with position " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> DocItemPos -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty DocItemPos
p1 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" \
\goes before doc item " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TypeRep -> String
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show (Proxy d2 -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy d2
dp2) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" with position " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> DocItemPos -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty DocItemPos
p2
where
p1 :: DocItemPos
p1 = forall d. DocItem d => DocItemPos
docItemPosition @d1
p2 :: DocItemPos
p2 = forall d. DocItem d => DocItemPos
docItemPosition @d2
goesBefore
:: forall d1 d2.
(DocItem d1, DocItem d2)
=> Proxy d1 -> Proxy d2 -> TestTree
goesBefore :: forall d1 d2.
(DocItem d1, DocItem d2) =>
Proxy d1 -> Proxy d2 -> TestTree
goesBefore Proxy d1
dp1 Proxy d2
dp2 = String -> Assertion -> TestTree
testCase String
testName (Proxy d1 -> Proxy d2 -> Assertion
forall d1 d2.
(DocItem d1, DocItem d2) =>
Proxy d1 -> Proxy d2 -> Assertion
assertGoesBefore Proxy d1
dp1 Proxy d2
dp2)
where
testName :: String
testName = Builder
"`" Builder -> Builder -> String
forall b. FromBuilder b => Builder -> Builder -> b
+| forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show @Text (Proxy d1 -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy d1
dp1) Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"` should come before `"
Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show @Text (Proxy d2 -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy d2
dp2) Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"`"
formatValue :: forall t. SingI t => T.Value t -> Builder
formatValue :: forall (t :: T). SingI t => Value t -> Builder
formatValue Value t
v = Builder
"" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Value t -> Builder
forall p. Buildable p => p -> Builder
build Value t
v Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" of type " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: T). (SingKind T, SingI a) => Demote T
demote @t T -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
formatSomeValue :: (forall t. c t => SingI t) => SomeConstrainedValue c -> Builder
formatSomeValue :: forall (c :: T -> Constraint).
(forall (t :: T). c t => SingI t) =>
SomeConstrainedValue c -> Builder
formatSomeValue = (forall (t :: T). c t => Value t -> Builder)
-> Constrained c Value -> Builder
forall {k} (c :: k -> Constraint) (f :: k -> *) r.
(forall (t :: k). c t => f t -> r) -> Constrained c f -> r
foldConstrained forall (t :: T). c t => Value t -> Builder
forall (t :: T). SingI t => Value t -> Builder
formatValue
data ShowWith a = ShowWith (a -> String) a
instance Eq a => Eq (ShowWith a) where
ShowWith a -> String
_ a
x == :: ShowWith a -> ShowWith a -> Bool
== ShowWith a -> String
_ a
y = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
instance Show (ShowWith a) where
showsPrec :: Int -> ShowWith a -> String -> String
showsPrec Int
d (ShowWith a -> String
f a
a) = Bool -> (String -> String) -> String -> String
Text.Show.showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
Text.Show.showString (String -> String -> String) -> String -> String -> String
forall a b. (a -> b) -> a -> b
$ a -> String
f a
a
where
app_prec :: Int
app_prec = Int
10
newtype Showing a = Showing a
deriving stock Showing a -> Showing a -> Bool
(Showing a -> Showing a -> Bool)
-> (Showing a -> Showing a -> Bool) -> Eq (Showing a)
forall a. Eq a => Showing a -> Showing a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Showing a -> Showing a -> Bool
$c/= :: forall a. Eq a => Showing a -> Showing a -> Bool
== :: Showing a -> Showing a -> Bool
$c== :: forall a. Eq a => Showing a -> Showing a -> Bool
Eq
deriving newtype Int -> Showing a -> String -> String
[Showing a] -> String -> String
Showing a -> String
(Int -> Showing a -> String -> String)
-> (Showing a -> String)
-> ([Showing a] -> String -> String)
-> Show (Showing a)
forall a. Show a => Int -> Showing a -> String -> String
forall a. Show a => [Showing a] -> String -> String
forall a. Show a => Showing a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Showing a] -> String -> String
$cshowList :: forall a. Show a => [Showing a] -> String -> String
show :: Showing a -> String
$cshow :: forall a. Show a => Showing a -> String
showsPrec :: Int -> Showing a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> Showing a -> String -> String
Show
instance Show a => Buildable (Showing a) where
build :: Showing a -> Builder
build (Showing a
a) = Text -> Builder
forall p. Buildable p => p -> Builder
build (forall b a. (Show a, IsString b) => a -> b
Debug.show @Text a
a)
ceilingUnit :: forall (unit :: Rat) . Time unit -> Time unit
ceilingUnit :: forall (unit :: Rat). Time unit -> Time unit
ceilingUnit = RatioNat -> Time unit
forall (unit :: Rat). RatioNat -> Time unit
time (RatioNat -> Time unit)
-> (Time unit -> RatioNat) -> Time unit -> Time unit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Natural -> RatioNat
forall a. Integral a => a -> a -> Ratio a
% Natural
1) (Natural -> RatioNat)
-> (Time unit -> Natural) -> Time unit -> RatioNat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RatioNat -> Natural
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (RatioNat -> Natural)
-> (Time unit -> RatioNat) -> Time unit -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time unit -> RatioNat
forall (rat :: Rat). Time rat -> RatioNat
unTime
timeToFixed
:: forall precision unit
. HasResolution precision
=> Time unit -> Fixed precision
timeToFixed :: forall {k} (precision :: k) (unit :: Rat).
HasResolution precision =>
Time unit -> Fixed precision
timeToFixed = forall a. Fractional a => Rational -> a
fromRational @(Fixed precision) (Rational -> Fixed precision)
-> (Time unit -> Rational) -> Time unit -> Fixed precision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RatioNat -> Rational
forall a. Real a => a -> Rational
toRational (RatioNat -> Rational)
-> (Time unit -> RatioNat) -> Time unit -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time unit -> RatioNat
forall (rat :: Rat). Time rat -> RatioNat
unTime
timeToNominalDiffTime :: KnownDivRat unit Second => Time unit -> NominalDiffTime
timeToNominalDiffTime :: forall (unit :: Rat).
KnownDivRat unit Second =>
Time unit -> NominalDiffTime
timeToNominalDiffTime =
Pico -> NominalDiffTime
secondsToNominalDiffTime (Pico -> NominalDiffTime)
-> (Time unit -> Pico) -> Time unit -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time (1 :% 1) -> Pico
forall {k} (precision :: k) (unit :: Rat).
HasResolution precision =>
Time unit -> Fixed precision
timeToFixed (Time (1 :% 1) -> Pico)
-> (Time unit -> Time (1 :% 1)) -> Time unit -> Pico
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Second
stripOptional0x :: Text -> Text
stripOptional0x :: Text -> Text
stripOptional0x Text
h = Text -> Text -> Maybe Text
T.stripPrefix Text
"0x" Text
h Maybe Text -> Text -> Text
forall a. Maybe a -> a -> a
?: Text
h
fromHex :: Text -> Either Text ByteString
fromHex :: Text -> Either Text ByteString
fromHex Text
hexText =
let errMsg :: a -> a
errMsg a
hex = a
"Invalid hex: \"" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
hex a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"\""
in Text -> Maybe ByteString -> Either Text ByteString
forall l r. l -> Maybe r -> Either l r
maybeToRight (Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
errMsg Text
hexText) (Maybe ByteString -> Either Text ByteString)
-> (Text -> Maybe ByteString) -> Text -> Either Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
decodeHex (Text -> Maybe ByteString)
-> (Text -> Text) -> Text -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
stripOptional0x (Text -> Either Text ByteString) -> Text -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ Text
hexText
parseAddressFromHex :: Text -> Either Text Address
parseAddressFromHex :: Text -> Either Text Address
parseAddressFromHex = Text -> Either Text ByteString
fromHex (Text -> Either Text ByteString)
-> (ByteString -> Either Text Address)
-> Text
-> Either Text Address
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ParseAddressRawError -> Text)
-> Either ParseAddressRawError Address -> Either Text Address
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseAddressRawError -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (Either ParseAddressRawError Address -> Either Text Address)
-> (ByteString -> Either ParseAddressRawError Address)
-> ByteString
-> Either Text Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ParseAddressRawError Address
parseAddressRaw
mapEach
:: (L.Each s t a b, Applicative m)
=> (a -> m b) -> s -> m t
mapEach :: forall s t a b (m :: * -> *).
(Each s t a b, Applicative m) =>
(a -> m b) -> s -> m t
mapEach = LensLike m s t a b -> LensLike m s t a b
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
L.traverseOf LensLike m s t a b
forall s t a b. Each s t a b => Traversal s t a b
L.each
forEach
:: (L.Each s t a b, Applicative m)
=> s -> (a -> m b) -> m t
forEach :: forall s t a b (m :: * -> *).
(Each s t a b, Applicative m) =>
s -> (a -> m b) -> m t
forEach = LensLike m s t a b -> s -> (a -> m b) -> m t
forall (f :: * -> *) s t a b.
LensLike f s t a b -> s -> (a -> f b) -> f t
L.forOf LensLike m s t a b
forall s t a b. Each s t a b => Traversal s t a b
L.each