{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE ViewPatterns #-}

module Test.Cardano.Ledger.Constrained.Size (
  Size (.., SzExact),
  seps,
  sepsP,
  sepn,
  runSize,
  atLeastDelta,
  atMostAny,
  genFromSize,
  genFromIntRange,
  genFromNonNegIntRange,
  negateSize,
  mergeSize,
) where

import qualified Data.List as List
import Test.Cardano.Ledger.Constrained.Combinators (errorMess)
import Test.Cardano.Ledger.Constrained.Monad (LiftT (..), Typed (..), failT)
import Test.QuickCheck (Gen, chooseInt)

-- ==============================================

seps :: [String] -> String
seps :: [String] -> String
seps [String]
xs = forall a. [a] -> [[a]] -> [a]
List.intercalate String
" " [String]
xs

sepsP :: [String] -> String
sepsP :: [String] -> String
sepsP [String]
xs = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
List.intercalate String
" " [String]
xs forall a. [a] -> [a] -> [a]
++ String
")"

sepn :: [String] -> String
sepn :: [String] -> String
sepn [String]
xs = forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\n   " [String]
xs

-- | Used in tests so things don't get too large
atLeastDelta :: Int
atLeastDelta :: Int
atLeastDelta = Int
5

-- | Used in tests so things don't get too large
--   If we can't find an era using things of size 10
--   using things of size 100, isn't going to help.
atMostAny :: Int
atMostAny :: Int
atMostAny = Int
10

-- =======================================================================================
-- The type Size and AddsSpec are defined in their own file because its type must be known
-- in many other modules, so to avoid recursive cycles this module depends on only Combinators
-- They act like a Spec, so there are Spec like Monoid and Semigroup instances.

data Size
  = SzNever [String]
  | SzAny
  | SzLeast Int
  | SzMost Int
  | -- | Size is in the range from @i@ to @j@ inclusive: @SzRng i j = [i .. j]@. Invariant @i <= j@
    SzRng Int Int
  deriving (Eq Size
Size -> Size -> Bool
Size -> Size -> Ordering
Size -> Size -> Size
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Size -> Size -> Size
$cmin :: Size -> Size -> Size
max :: Size -> Size -> Size
$cmax :: Size -> Size -> Size
>= :: Size -> Size -> Bool
$c>= :: Size -> Size -> Bool
> :: Size -> Size -> Bool
$c> :: Size -> Size -> Bool
<= :: Size -> Size -> Bool
$c<= :: Size -> Size -> Bool
< :: Size -> Size -> Bool
$c< :: Size -> Size -> Bool
compare :: Size -> Size -> Ordering
$ccompare :: Size -> Size -> Ordering
Ord, Size -> Size -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c== :: Size -> Size -> Bool
Eq)

instance LiftT Size where
  liftT :: Size -> Typed Size
liftT (SzNever [String]
xs) = forall a. [String] -> Typed a
failT [String]
xs
  liftT Size
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure Size
x
  dropT :: Typed Size -> Size
dropT (Typed (Left [String]
s)) = [String] -> Size
SzNever [String]
s
  dropT (Typed (Right Size
x)) = Size
x

sameR :: Size -> Maybe Int
sameR :: Size -> Maybe Int
sameR (SzRng Int
x Int
y) = if Int
x forall a. Eq a => a -> a -> Bool
== Int
y then forall a. a -> Maybe a
Just Int
x else forall a. Maybe a
Nothing
sameR Size
_ = forall a. Maybe a
Nothing

pattern SzExact :: Int -> Size
pattern $bSzExact :: Int -> Size
$mSzExact :: forall {r}. Size -> (Int -> r) -> ((# #) -> r) -> r
SzExact x <- (sameR -> Just x)
  where
    SzExact Int
x = (Int -> Int -> Size
SzRng Int
x Int
x)

instance Show Size where
  show :: Size -> String
show (SzNever [String]
_) = String
"NeverSize"
  show Size
SzAny = String
"AnySize"
  show (SzLeast Int
n) = String
"(AtLeast " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
")"
  show (SzMost Int
n) = String
"(AtMost " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
")"
  show (SzRng Int
i Int
j) = String
"(Range " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
j forall a. [a] -> [a] -> [a]
++ String
")"

negateSize :: Size -> Size
negateSize :: Size -> Size
negateSize (SzLeast Int
n) = Int -> Size
SzMost (-Int
n)
negateSize (SzMost Int
n) = Int -> Size
SzLeast (-Int
n)
negateSize (SzRng Int
i Int
j) = Int -> Int -> Size
SzRng (-Int
j) (-Int
i)
negateSize Size
x = Size
x

mergeSize :: Size -> Size -> Size
mergeSize :: Size -> Size -> Size
mergeSize Size
SzAny Size
x = Size
x
mergeSize Size
x Size
SzAny = Size
x
mergeSize (SzNever [String]
xs) (SzNever [String]
ys) = [String] -> Size
SzNever ([String]
xs forall a. [a] -> [a] -> [a]
++ [String]
ys)
mergeSize Size
_ (SzNever [String]
xs) = [String] -> Size
SzNever [String]
xs
mergeSize (SzNever [String]
xs) Size
_ = [String] -> Size
SzNever [String]
xs
mergeSize (SzLeast Int
x) (SzLeast Int
y) = Int -> Size
SzLeast (forall a. Ord a => a -> a -> a
max Int
x Int
y)
mergeSize (SzLeast Int
x) (SzMost Int
y) | Int
x forall a. Ord a => a -> a -> Bool
<= Int
y = Int -> Int -> Size
SzRng Int
x Int
y
mergeSize (SzLeast Int
x) (SzRng Int
i Int
j) | Int
x forall a. Ord a => a -> a -> Bool
<= Int
i = Int -> Int -> Size
SzRng Int
i Int
j
mergeSize (SzLeast Int
x) (SzRng Int
i Int
j) | Int
x forall a. Ord a => a -> a -> Bool
>= Int
i Bool -> Bool -> Bool
&& Int
x forall a. Ord a => a -> a -> Bool
<= Int
j = Int -> Int -> Size
SzRng Int
x Int
j
mergeSize (SzMost Int
x) (SzMost Int
y) = Int -> Size
SzMost (forall a. Ord a => a -> a -> a
min Int
x Int
y)
mergeSize (SzMost Int
y) (SzLeast Int
x) | Int
x forall a. Ord a => a -> a -> Bool
<= Int
y = Int -> Int -> Size
SzRng Int
x Int
y
mergeSize (SzMost Int
x) (SzRng Int
i Int
j) | Int
x forall a. Ord a => a -> a -> Bool
>= Int
j = Int -> Int -> Size
SzRng Int
i Int
j
mergeSize (SzMost Int
x) (SzRng Int
i Int
j) | Int
x forall a. Ord a => a -> a -> Bool
>= Int
i Bool -> Bool -> Bool
&& Int
x forall a. Ord a => a -> a -> Bool
<= Int
j = Int -> Int -> Size
SzRng Int
i Int
x
mergeSize (SzRng Int
i Int
j) (SzLeast Int
x) | Int
x forall a. Ord a => a -> a -> Bool
<= Int
i = Int -> Int -> Size
SzRng Int
i Int
j
mergeSize (SzRng Int
i Int
j) (SzLeast Int
x) | Int
x forall a. Ord a => a -> a -> Bool
>= Int
i Bool -> Bool -> Bool
&& Int
x forall a. Ord a => a -> a -> Bool
<= Int
j = Int -> Int -> Size
SzRng Int
x Int
j
mergeSize (SzRng Int
i Int
j) (SzMost Int
x) | Int
x forall a. Ord a => a -> a -> Bool
>= Int
j = Int -> Int -> Size
SzRng Int
i Int
j
mergeSize (SzRng Int
i Int
j) (SzMost Int
x) | Int
x forall a. Ord a => a -> a -> Bool
>= Int
i Bool -> Bool -> Bool
&& Int
x forall a. Ord a => a -> a -> Bool
<= Int
j = Int -> Int -> Size
SzRng Int
i Int
x
mergeSize (SzRng Int
i Int
j) (SzRng Int
m Int
n) | Int
x forall a. Ord a => a -> a -> Bool
<= Int
y = Int -> Int -> Size
SzRng Int
x Int
y
  where
    x :: Int
x = forall a. Ord a => a -> a -> a
max Int
i Int
m
    y :: Int
y = forall a. Ord a => a -> a -> a
min Int
j Int
n
mergeSize Size
a Size
b = [String] -> Size
SzNever [String
"Size specifications " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Size
a forall a. [a] -> [a] -> [a]
++ String
" and " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Size
b forall a. [a] -> [a] -> [a]
++ String
" are inconsistent."]

instance Monoid Size where mempty :: Size
mempty = Size
SzAny

instance Semigroup Size where
  <> :: Size -> Size -> Size
(<>) = Size -> Size -> Size
mergeSize

runSize :: Int -> Size -> Bool
runSize :: Int -> Size -> Bool
runSize Int
_ (SzNever [String]
xs) = forall a. HasCallStack => String -> [String] -> a
errorMess String
"SzNever in runSizeSpec" [String]
xs
runSize Int
_ Size
SzAny = Bool
True
runSize Int
n (SzLeast Int
m) = Int
n forall a. Ord a => a -> a -> Bool
>= Int
m
runSize Int
n (SzMost Int
m) = Int
n forall a. Ord a => a -> a -> Bool
<= Int
m
runSize Int
n (SzRng Int
i Int
j) = Int
n forall a. Ord a => a -> a -> Bool
>= Int
i Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
j

-- | Use to generate real sizes, where there are no negative numbers,
--   and the smallest possible size is 0.
--   Use this only where you know it is NOT SzNever
genFromSize :: Size -> Gen Int
genFromSize :: Size -> Gen Int
genFromSize (SzNever [String]
_) = forall a. HasCallStack => String -> a
error String
"Bad call to (genFromSize(SzNever ..))."
genFromSize Size
SzAny = (Int, Int) -> Gen Int
chooseInt (Int
0, Int
atMostAny)
genFromSize (SzRng Int
i Int
j) = (Int, Int) -> Gen Int
chooseInt (forall a. Ord a => a -> a -> a
max Int
i Int
0, forall a. Ord a => a -> a -> a
max Int
i forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min Int
atMostAny Int
j)
genFromSize (SzLeast Int
i) = (Int, Int) -> Gen Int
chooseInt (forall a. Ord a => a -> a -> a
max Int
i Int
0, forall a. Ord a => a -> a -> a
max Int
i Int
0 forall a. Num a => a -> a -> a
+ Int
atLeastDelta)
genFromSize (SzMost Int
i) = (Int, Int) -> Gen Int
chooseInt (Int
0, forall a. Ord a => a -> a -> a
min Int
atMostAny Int
i)

-- | Similar to genFromSize, but allows negative numbers (unlike size where the smallest Int is 0)
genFromIntRange :: Size -> Gen Int
genFromIntRange :: Size -> Gen Int
genFromIntRange (SzNever [String]
_) = forall a. HasCallStack => String -> a
error String
"Bad call to (genFromIntRange(SzNever ..))."
genFromIntRange Size
SzAny = (Int, Int) -> Gen Int
chooseInt (-Int
atMostAny, Int
atMostAny)
genFromIntRange (SzRng Int
i Int
j) = (Int, Int) -> Gen Int
chooseInt (Int
i, Int
j)
genFromIntRange (SzLeast Int
i) = (Int, Int) -> Gen Int
chooseInt (Int
i, Int
i forall a. Num a => a -> a -> a
+ Int
atLeastDelta)
genFromIntRange (SzMost Int
i) = (Int, Int) -> Gen Int
chooseInt (Int
i forall a. Num a => a -> a -> a
- Int
atMostAny, Int
i)

genFromNonNegIntRange :: Size -> Gen Int
genFromNonNegIntRange :: Size -> Gen Int
genFromNonNegIntRange Size
sz = forall a. Ord a => a -> a -> a
max Int
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Size -> Gen Int
genFromIntRange Size
sz