-- |
-- Module      : Verismith
-- Description : Verismith
-- Copyright   : (c) 2018-2023, Yann Herklotz
-- License     : GPL-3
-- Maintainer  : yann [at] yannherklotz [dot] com
-- Stability   : experimental
-- Portability : POSIX
module Verismith.Utils
  ( generateByteString,
    nonEmpty,
    foldrMap1,
    foldrMap1',
    foldrMapM1,
    mkpair,
    uncurry3,
    safe,
    showT,
    showBS,
    comma,
    commaNL,
  )
where

import Control.Applicative
import Data.ByteString (ByteString, pack)
import Data.ByteString.Builder (byteStringHex, toLazyByteString)
import qualified Data.ByteString.Lazy as L
import Data.List.NonEmpty (NonEmpty (..), (<|))
import qualified Data.List.NonEmpty as NE
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
import System.Random (mkStdGen, newStdGen, randoms)

-- List and nonempty list utils

nonEmpty :: b -> (NonEmpty a -> b) -> [a] -> b
nonEmpty :: forall b a. b -> (NonEmpty a -> b) -> [a] -> b
nonEmpty b
e NonEmpty a -> b
ne = b -> (NonEmpty a -> b) -> Maybe (NonEmpty a) -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
e NonEmpty a -> b
ne (Maybe (NonEmpty a) -> b)
-> ([a] -> Maybe (NonEmpty a)) -> [a] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty

foldrMap1 :: (a -> b) -> (a -> b -> b) -> NonEmpty a -> b
foldrMap1 :: forall a b. (a -> b) -> (a -> b -> b) -> NonEmpty a -> b
foldrMap1 a -> b
f a -> b -> b
g (a
h :| [a]
t) = b -> (NonEmpty a -> b) -> [a] -> b
forall b a. b -> (NonEmpty a -> b) -> [a] -> b
nonEmpty (a -> b
f a
h) (\NonEmpty a
x -> a -> b -> b
g a
h (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> (a -> b -> b) -> NonEmpty a -> b
forall a b. (a -> b) -> (a -> b -> b) -> NonEmpty a -> b
foldrMap1 a -> b
f a -> b -> b
g NonEmpty a
x) [a]
t

foldrMap1' :: b -> (a -> b) -> (a -> b -> b) -> [a] -> b
foldrMap1' :: forall b a. b -> (a -> b) -> (a -> b -> b) -> [a] -> b
foldrMap1' b
d a -> b
f a -> b -> b
g = b -> (NonEmpty a -> b) -> [a] -> b
forall b a. b -> (NonEmpty a -> b) -> [a] -> b
nonEmpty b
d ((a -> b) -> (a -> b -> b) -> NonEmpty a -> b
forall a b. (a -> b) -> (a -> b -> b) -> NonEmpty a -> b
foldrMap1 a -> b
f a -> b -> b
g)

foldrMapM1 :: (Applicative m, Monad m) => (a -> m b) -> (a -> b -> m b) -> NonEmpty a -> m b
foldrMapM1 :: forall (m :: * -> *) a b.
(Applicative m, Monad m) =>
(a -> m b) -> (a -> b -> m b) -> NonEmpty a -> m b
foldrMapM1 a -> m b
f a -> b -> m b
g (a
h :| [a]
t) = m b -> (NonEmpty a -> m b) -> [a] -> m b
forall b a. b -> (NonEmpty a -> b) -> [a] -> b
nonEmpty (a -> m b
f a
h) (\NonEmpty a
x -> (a -> m b) -> (a -> b -> m b) -> NonEmpty a -> m b
forall (m :: * -> *) a b.
(Applicative m, Monad m) =>
(a -> m b) -> (a -> b -> m b) -> NonEmpty a -> m b
foldrMapM1 a -> m b
f a -> b -> m b
g NonEmpty a
x m b -> (b -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> b -> m b
g a
h) [a]
t

mkpair :: Applicative f => f a -> f b -> f (a, b)
mkpair :: forall (f :: * -> *) a b. Applicative f => f a -> f b -> f (a, b)
mkpair = (a -> b -> (a, b)) -> f a -> f b -> f (a, b)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,)

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

generateByteString :: (Maybe Int) -> Int -> Int -> IO [ByteString]
generateByteString :: Maybe Int -> Int -> Int -> IO [ByteString]
generateByteString Maybe Int
mseed Int
size Int
n = do
  ([Word8] -> ByteString) -> [[Word8]] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
pack ([[Word8]] -> [ByteString])
-> (StdGen -> [[Word8]]) -> StdGen -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word8] -> [[Word8]]
forall {a}. Int -> [a] -> [[a]]
chunksOf Int
size ([Word8] -> [[Word8]])
-> (StdGen -> [Word8]) -> StdGen -> [[Word8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) ([Word8] -> [Word8]) -> (StdGen -> [Word8]) -> StdGen -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdGen -> [Word8]
forall g. RandomGen g => g -> [Word8]
forall a g. (Random a, RandomGen g) => g -> [a]
randoms
    (StdGen -> [ByteString]) -> IO StdGen -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe Int
mseed of
      Just Int
seed' -> StdGen -> IO StdGen
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (StdGen -> IO StdGen) -> StdGen -> IO StdGen
forall a b. (a -> b) -> a -> b
$ Int -> StdGen
mkStdGen Int
seed'
      Maybe Int
Nothing -> IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
  where
    chunksOf :: Int -> [a] -> [[a]]
chunksOf Int
i [a]
_ | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Char] -> [[a]]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [[a]]) -> [Char] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [Char]
"chunksOf, number must be positive, got " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i
    chunksOf Int
i [a]
xs = ([a] -> ([a], [a])) -> [a] -> [[a]]
forall {a} {a}. ([a] -> (a, [a])) -> [a] -> [a]
repeatedly (Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i) [a]
xs
    repeatedly :: ([a] -> (a, [a])) -> [a] -> [a]
repeatedly [a] -> (a, [a])
_ [] = []
    repeatedly [a] -> (a, [a])
f [a]
as = a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ([a] -> (a, [a])) -> [a] -> [a]
repeatedly [a] -> (a, [a])
f [a]
as'
      where
        (a
b, [a]
as') = [a] -> (a, [a])
f [a]
as

-- | Function to show a bytestring in a hex format.
showBS :: ByteString -> Text
showBS :: ByteString -> Text
showBS = ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> (ByteString -> Builder) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
byteStringHex

-- | Converts unsafe list functions in the Prelude to a safe version.
safe :: ([a] -> b) -> [a] -> Maybe b
safe :: forall a b. ([a] -> b) -> [a] -> Maybe b
safe [a] -> b
_ [] = Maybe b
forall a. Maybe a
Nothing
safe [a] -> b
f [a]
l = b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$ [a] -> b
f [a]
l

-- | Show function for 'Text'
showT :: (Show a) => a -> Text
showT :: forall a. Show a => a -> Text
showT = [Char] -> Text
T.pack ([Char] -> Text) -> (a -> [Char]) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show

-- | Inserts commas between '[Text]' and except the last one.
comma :: [Text] -> Text
comma :: [Text] -> Text
comma = Text -> [Text] -> Text
T.intercalate Text
", "

-- | Inserts commas and newlines between '[Text]' and except the last one.
commaNL :: [Text] -> Text
commaNL :: [Text] -> Text
commaNL = Text -> [Text] -> Text
T.intercalate Text
",\n"