-- |
-- Module      : Test.Speculate.Utils.Misc
-- Copyright   : (c) 2016-2024 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- This module is part of Speculate.
--
-- Miscellaneous utilities.
module Test.Speculate.Utils.Misc where

import Data.Maybe
import Data.Ratio
import Test.Speculate.Utils.String
import Test.Speculate.Utils.List

-- easy debug:
undefined1 :: a
undefined1 :: forall a. a
undefined1 = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"undefined1"

undefined2 :: a
undefined2 :: forall a. a
undefined2 = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"undefined2"

thn :: Ordering -> Ordering -> Ordering
thn :: Ordering -> Ordering -> Ordering
thn Ordering
EQ Ordering
o = Ordering
o
thn Ordering
o  Ordering
_ = Ordering
o
infixr 8 `thn`

-- TODO: Remove this function in favour of LeanCheck's classStats
reportCountsBy :: (Eq b, Show b) => (a -> b) -> [a] -> IO ()
reportCountsBy :: forall b a. (Eq b, Show b) => (a -> b) -> [a] -> IO ()
reportCountsBy a -> b
f [a]
xs = [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> ([(b, Int)] -> [Char]) -> [(b, Int)] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unlines
                    ([[Char]] -> [Char])
-> ([(b, Int)] -> [[Char]]) -> [(b, Int)] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, Int) -> [Char]) -> [(b, Int)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (b, Int) -> [Char]
forall {a}. Show a => (a, Int) -> [Char]
showCount ([(b, Int)] -> IO ()) -> [(b, Int)] -> IO ()
forall a b. (a -> b) -> a -> b
$ (a -> b) -> [a] -> [(b, Int)]
forall b a. Eq b => (a -> b) -> [a] -> [(b, Int)]
countsOn a -> b
f [a]
xs
  where
  len :: Int
len = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
  showCount :: (a, Int) -> [Char]
showCount (a
x,Int
n) = [Char] -> [Char]
unquote (a -> [Char]
forall a. Show a => a -> [Char]
show a
x) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": "
                 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
len [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" "
                 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
len) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"%"

maybesToMaybe :: [Maybe a] -> Maybe a
maybesToMaybe :: forall a. [Maybe a] -> Maybe a
maybesToMaybe = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> ([Maybe a] -> [a]) -> [Maybe a] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes

maybe2 :: c -> (a -> b -> c) -> Maybe a -> Maybe b -> c
maybe2 :: forall c a b. c -> (a -> b -> c) -> Maybe a -> Maybe b -> c
maybe2 c
_ a -> b -> c
f (Just a
x) (Just b
y) = a -> b -> c
f a
x b
y
maybe2 c
z a -> b -> c
_ Maybe a
_        Maybe b
_        = c
z

iterateUntil :: (a -> a -> Bool) -> (a -> a) -> a -> a
iterateUntil :: forall a. (a -> a -> Bool) -> (a -> a) -> a -> a
iterateUntil a -> a -> Bool
p a -> a
f a
x = let fx :: a
fx = a -> a
f a
x
                     in if a
x a -> a -> Bool
`p` a
fx
                          then a
x
                          else (a -> a -> Bool) -> (a -> a) -> a -> a
forall a. (a -> a -> Bool) -> (a -> a) -> a -> a
iterateUntil a -> a -> Bool
p a -> a
f a
fx

iterateUntilLimit :: Int -> (a -> a -> Bool) -> (a -> a) -> a -> a
iterateUntilLimit :: forall a. Int -> (a -> a -> Bool) -> (a -> a) -> a -> a
iterateUntilLimit Int
0 a -> a -> Bool
p a -> a
f a
x = a
x
iterateUntilLimit Int
n a -> a -> Bool
p a -> a
f a
x = let fx :: a
fx = a -> a
f a
x
                            in if a
x a -> a -> Bool
`p` a
fx
                                 then a
x
                                 else Int -> (a -> a -> Bool) -> (a -> a) -> a -> a
forall a. Int -> (a -> a -> Bool) -> (a -> a) -> a -> a
iterateUntilLimit (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a -> a -> Bool
p a -> a
f a
fx

showRatio :: (Integral a, Show a) => Ratio a -> String
showRatio :: forall a. (Integral a, Show a) => Ratio a -> [Char]
showRatio Ratio a
r = a -> [Char]
forall a. Show a => a -> [Char]
show (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show (Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
r)

percent :: Integral a => Ratio a -> a
percent :: forall a. Integral a => Ratio a -> a
percent Ratio a
r = Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r a -> a -> a
forall a. Num a => a -> a -> a
* a
100 a -> a -> a
forall a. Integral a => a -> a -> a
`div` Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
r

putLines :: [String] -> IO ()
putLines :: [[Char]] -> IO ()
putLines [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
putLines [[Char]]
ls = [Char] -> IO ()
putStrLn ([[Char]] -> [Char]
unlines [[Char]]
ls)

(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
.: :: forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
(.:) = ((b -> c) -> b -> d) -> (a -> b -> c) -> a -> b -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (((b -> c) -> b -> d) -> (a -> b -> c) -> a -> b -> d)
-> ((c -> d) -> (b -> c) -> b -> d)
-> (c -> d)
-> (a -> b -> c)
-> a
-> b
-> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> d) -> (b -> c) -> b -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)

(..:) :: (d -> e) -> (a -> b -> c -> d) -> a -> b -> c -> e
..: :: forall d e a b c.
(d -> e) -> (a -> b -> c -> d) -> a -> b -> c -> e
(..:) = ((b -> c -> d) -> b -> c -> e)
-> (a -> b -> c -> d) -> a -> b -> c -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (((b -> c -> d) -> b -> c -> e)
 -> (a -> b -> c -> d) -> a -> b -> c -> e)
-> ((d -> e) -> (b -> c -> d) -> b -> c -> e)
-> (d -> e)
-> (a -> b -> c -> d)
-> a
-> b
-> c
-> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (d -> e) -> (b -> c -> d) -> b -> c -> e
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
(.:)