{-# LANGUAGE DeriveGeneric #-}

module HaskellWorks.Data.BalancedParens.Gen
  ( BP(..)
  , count
  , bpBools
  , showBps
  , storableVector
  , bpParensSeq
  , vector
  , vec2
  , randomRm
  , randomRm2
  ) where

import Data.Coerce
import Data.Word
import GHC.Generics
import HaskellWorks.Data.BalancedParens.ParensSeq (ParensSeq)
import HaskellWorks.Data.Positioning
import Hedgehog

import qualified Data.Vector                                as DV
import qualified Data.Vector.Storable                       as DVS
import qualified HaskellWorks.Data.BalancedParens.ParensSeq as PS
import qualified HaskellWorks.Data.BalancedParens.RangeMin  as RM
import qualified HaskellWorks.Data.BalancedParens.RangeMin2 as RM2
import qualified Hedgehog.Gen                               as G
import qualified Hedgehog.Range                             as R

{- HLINT ignore "Use guards" -}

count :: MonadGen m => Range Count -> m Count
count :: forall (m :: * -> *). MonadGen m => Range Count -> m Count
count Range Count
r = coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGen m => Range Count -> m Count
G.word64 (coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Count
r)

data LR a = L a Int | R a Int deriving (LR a -> LR a -> Bool
forall a. Eq a => LR a -> LR a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LR a -> LR a -> Bool
$c/= :: forall a. Eq a => LR a -> LR a -> Bool
== :: LR a -> LR a -> Bool
$c== :: forall a. Eq a => LR a -> LR a -> Bool
Eq, Int -> LR a -> ShowS
forall a. Show a => Int -> LR a -> ShowS
forall a. Show a => [LR a] -> ShowS
forall a. Show a => LR a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LR a] -> ShowS
$cshowList :: forall a. Show a => [LR a] -> ShowS
show :: LR a -> String
$cshow :: forall a. Show a => LR a -> String
showsPrec :: Int -> LR a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> LR a -> ShowS
Show)

newtype BP = BP [Bool] deriving (BP -> BP -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BP -> BP -> Bool
$c/= :: BP -> BP -> Bool
== :: BP -> BP -> Bool
$c== :: BP -> BP -> Bool
Eq, forall x. Rep BP x -> BP
forall x. BP -> Rep BP x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BP x -> BP
$cfrom :: forall x. BP -> Rep BP x
Generic)

showBps :: [Bool] -> String
showBps :: [Bool] -> String
showBps = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Char
fromBool
  where fromBool :: Bool -> Char
fromBool Bool
True  = Char
'('
        fromBool Bool
False = Char
')'

bpBools' :: MonadGen m => Int -> (Int, [Bool], [Bool], Int) -> m [Bool]
bpBools' :: forall (m :: * -> *).
MonadGen m =>
Int -> (Int, [Bool], [Bool], Int) -> m [Bool]
bpBools' Int
n (Int
ln, [Bool]
lt, [Bool]
rt, Int
rn) = if Int
n forall a. Ord a => a -> a -> Bool
<= Int
0
  then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> [a]
reverse [Bool]
lt forall a. Semigroup a => a -> a -> a
<> [Bool]
rt)
  else if Int
ln forall a. Num a => a -> a -> a
- Int
rn forall a. Ord a => a -> a -> Bool
>= Int
n
    then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> [a]
reverse [Bool]
lt forall a. Semigroup a => a -> a -> a
<> forall a. Int -> a -> [a]
replicate Int
n Bool
False forall a. Semigroup a => a -> a -> a
<> [Bool]
rt)
    else if Int
rn forall a. Num a => a -> a -> a
- Int
ln forall a. Ord a => a -> a -> Bool
>= Int
n
      then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> [a]
reverse [Bool]
lt forall a. Semigroup a => a -> a -> a
<> forall a. Int -> a -> [a]
replicate Int
n Bool
True forall a. Semigroup a => a -> a -> a
<> [Bool]
rt)
      else do
        LR Char
decision <- case (Int
ln, Int
rn) of
          (Int
0, Int
0) -> forall (m :: * -> *) a. MonadGen m => [a] -> m a
G.element [forall a. a -> Int -> LR a
L Char
'(' Int
1,                         forall a. a -> Int -> LR a
R Char
')' Int
1]
          (Int
0, Int
_) -> forall (m :: * -> *) a. MonadGen m => [a] -> m a
G.element [forall a. a -> Int -> LR a
L Char
'(' Int
1,             forall a. a -> Int -> LR a
R Char
'(' (-Int
1), forall a. a -> Int -> LR a
R Char
')' Int
1]
          (Int
_, Int
0) -> forall (m :: * -> *) a. MonadGen m => [a] -> m a
G.element [forall a. a -> Int -> LR a
L Char
'(' Int
1, forall a. a -> Int -> LR a
L Char
')' (-Int
1),             forall a. a -> Int -> LR a
R Char
')' Int
1]
          (Int, Int)
_      -> forall (m :: * -> *) a. MonadGen m => [a] -> m a
G.element [forall a. a -> Int -> LR a
L Char
'(' Int
1,                         forall a. a -> Int -> LR a
R Char
')' Int
1]

        case LR Char
decision of
          L Char
p Int
d -> forall (m :: * -> *).
MonadGen m =>
Int -> (Int, [Bool], [Bool], Int) -> m [Bool]
bpBools' (Int
n forall a. Num a => a -> a -> a
- Int
1) (Int
ln forall a. Num a => a -> a -> a
+ Int
d, Char -> Bool
toBool Char
pforall a. a -> [a] -> [a]
:[Bool]
lt,          [Bool]
rt, Int
rn    )
          R Char
p Int
d -> forall (m :: * -> *).
MonadGen m =>
Int -> (Int, [Bool], [Bool], Int) -> m [Bool]
bpBools' (Int
n forall a. Num a => a -> a -> a
- Int
1) (Int
ln    ,          [Bool]
lt, Char -> Bool
toBool Char
pforall a. a -> [a] -> [a]
:[Bool]
rt, Int
rn forall a. Num a => a -> a -> a
+ Int
d)
  where toBool :: Char -> Bool
toBool Char
'(' = Bool
True
        toBool  Char
_  = Bool
False

bpBools ::  MonadGen m => Range Int -> m [Bool]
bpBools :: forall (m :: * -> *). MonadGen m => Range Int -> m [Bool]
bpBools Range Int
r = do
  Int
n <- forall (m :: * -> *). MonadGen m => Range Int -> m Int
G.int Range Int
r
  forall (m :: * -> *).
MonadGen m =>
Int -> (Int, [Bool], [Bool], Int) -> m [Bool]
bpBools' (Int
n forall a. Num a => a -> a -> a
* Int
2) (Int
0, [], [], Int
0)

bpParensSeq ::  MonadGen m => Range Int -> m ParensSeq
bpParensSeq :: forall (m :: * -> *). MonadGen m => Range Int -> m ParensSeq
bpParensSeq = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Bool] -> ParensSeq
PS.fromBools forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadGen m => Range Int -> m [Bool]
bpBools

storableVector :: (MonadGen m, DVS.Storable a) => Range Int -> m a -> m (DVS.Vector a)
storableVector :: forall (m :: * -> *) a.
(MonadGen m, Storable a) =>
Range Int -> m a -> m (Vector a)
storableVector Range Int
r m a
g = forall a. Storable a => [a] -> Vector a
DVS.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
G.list Range Int
r m a
g

vector :: MonadGen m => Range Int -> m a -> m (DV.Vector a)
vector :: forall (m :: * -> *) a.
MonadGen m =>
Range Int -> m a -> m (Vector a)
vector Range Int
r m a
g = forall a. [a] -> Vector a
DV.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
G.list Range Int
r m a
g

vec2 :: MonadGen m => m a -> m (a, a)
vec2 :: forall (m :: * -> *) a. MonadGen m => m a -> m (a, a)
vec2 m a
g = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a
g

randomRm :: MonadGen m => Range Int -> m (RM.RangeMin (DVS.Vector Word64))
randomRm :: forall (m :: * -> *).
MonadGen m =>
Range Int -> m (RangeMin (Vector Count))
randomRm Range Int
r = do
  Vector Count
v <- forall (m :: * -> *) a.
(MonadGen m, Storable a) =>
Range Int -> m a -> m (Vector a)
storableVector (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
64 forall a. Num a => a -> a -> a
*) Range Int
r) (forall (m :: * -> *). MonadGen m => Range Count -> m Count
G.word64 forall a. (Bounded a, Num a) => Range a
R.constantBounded)
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. AsVector64 a => a -> RangeMin a
RM.mkRangeMin Vector Count
v)

randomRm2 :: MonadGen m => Range Int -> m (RM2.RangeMin2 (DVS.Vector Word64))
randomRm2 :: forall (m :: * -> *).
MonadGen m =>
Range Int -> m (RangeMin2 (Vector Count))
randomRm2 Range Int
r = do
  Vector Count
v <- forall (m :: * -> *) a.
(MonadGen m, Storable a) =>
Range Int -> m a -> m (Vector a)
storableVector (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
64 forall a. Num a => a -> a -> a
*) Range Int
r) (forall (m :: * -> *). MonadGen m => Range Count -> m Count
G.word64 forall a. (Bounded a, Num a) => Range a
R.constantBounded)
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. AsVector64 a => a -> RangeMin2 a
RM2.mkRangeMin2 Vector Count
v)