{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DuplicateRecordFields      #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE TypeFamilies               #-}

module HaskellWorks.Data.BalancedParens.Internal.ParensSeq
  ( Elem(..)
  , Measure(..)
  , ParensSeq(..)
  , ParensSeqFt
  , (|>#)
  , (#<|)
  , ftSplit
  , atSizeBelowZero
  , atMinZero
  ) where

import Control.DeepSeq
import Data.Int
import Data.Word
import GHC.Generics
import HaskellWorks.Data.Bits.BitWise
import HaskellWorks.Data.Excess.MinExcess
import HaskellWorks.Data.Excess.PartialMinExcess1
import HaskellWorks.Data.FingerTree               (ViewL (..), ViewR (..), (<|), (><), (|>))
import HaskellWorks.Data.Positioning
import Prelude                                    hiding (max, min)

import qualified HaskellWorks.Data.Cons       as HW
import qualified HaskellWorks.Data.Container  as HW
import qualified HaskellWorks.Data.FingerTree as FT
import qualified HaskellWorks.Data.Snoc       as HW
import qualified Prelude                      as P

data Elem = Elem
  { Elem -> Count
bps  :: {-# UNPACK #-} !Word64
  , Elem -> Count
size :: {-# UNPACK #-} !Count
  } deriving (Elem -> Elem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Elem -> Elem -> Bool
$c/= :: Elem -> Elem -> Bool
== :: Elem -> Elem -> Bool
$c== :: Elem -> Elem -> Bool
Eq, Int -> Elem -> ShowS
[Elem] -> ShowS
Elem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Elem] -> ShowS
$cshowList :: [Elem] -> ShowS
show :: Elem -> String
$cshow :: Elem -> String
showsPrec :: Int -> Elem -> ShowS
$cshowsPrec :: Int -> Elem -> ShowS
Show, forall x. Rep Elem x -> Elem
forall x. Elem -> Rep Elem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Elem x -> Elem
$cfrom :: forall x. Elem -> Rep Elem x
Generic)

instance NFData Elem

data Measure = Measure
  { Measure -> Count
size   :: {-# UNPACK #-} !Count
  , Measure -> Int
min    :: {-# UNPACK #-} !Int
  , Measure -> Int
excess :: {-# UNPACK #-} !Int
  } deriving (Measure -> Measure -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Measure -> Measure -> Bool
$c/= :: Measure -> Measure -> Bool
== :: Measure -> Measure -> Bool
$c== :: Measure -> Measure -> Bool
Eq, Eq Measure
Measure -> Measure -> Bool
Measure -> Measure -> Ordering
Measure -> Measure -> Measure
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 :: Measure -> Measure -> Measure
$cmin :: Measure -> Measure -> Measure
max :: Measure -> Measure -> Measure
$cmax :: Measure -> Measure -> Measure
>= :: Measure -> Measure -> Bool
$c>= :: Measure -> Measure -> Bool
> :: Measure -> Measure -> Bool
$c> :: Measure -> Measure -> Bool
<= :: Measure -> Measure -> Bool
$c<= :: Measure -> Measure -> Bool
< :: Measure -> Measure -> Bool
$c< :: Measure -> Measure -> Bool
compare :: Measure -> Measure -> Ordering
$ccompare :: Measure -> Measure -> Ordering
Ord, Int -> Measure -> ShowS
[Measure] -> ShowS
Measure -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Measure] -> ShowS
$cshowList :: [Measure] -> ShowS
show :: Measure -> String
$cshow :: Measure -> String
showsPrec :: Int -> Measure -> ShowS
$cshowsPrec :: Int -> Measure -> ShowS
Show, forall x. Rep Measure x -> Measure
forall x. Measure -> Rep Measure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Measure x -> Measure
$cfrom :: forall x. Measure -> Rep Measure x
Generic)

instance NFData Measure

type ParensSeqFt = FT.FingerTree Measure Elem

newtype ParensSeq = ParensSeq
  { ParensSeq -> ParensSeqFt
parens :: ParensSeqFt
  } deriving (Int -> ParensSeq -> ShowS
[ParensSeq] -> ShowS
ParensSeq -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParensSeq] -> ShowS
$cshowList :: [ParensSeq] -> ShowS
show :: ParensSeq -> String
$cshow :: ParensSeq -> String
showsPrec :: Int -> ParensSeq -> ShowS
$cshowsPrec :: Int -> ParensSeq -> ShowS
Show, ParensSeq -> ()
forall a. (a -> ()) -> NFData a
rnf :: ParensSeq -> ()
$crnf :: ParensSeq -> ()
NFData, forall x. Rep ParensSeq x -> ParensSeq
forall x. ParensSeq -> Rep ParensSeq x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParensSeq x -> ParensSeq
$cfrom :: forall x. ParensSeq -> Rep ParensSeq x
Generic)

instance Semigroup Measure where
  Measure Count
aSize Int
aMin Int
aExcess <> :: Measure -> Measure -> Measure
<> Measure Count
bSize Int
bMin Int
bExcess = Measure
    { $sel:size:Measure :: Count
size    = Count
aSize forall a. Num a => a -> a -> a
+ Count
bSize
    , $sel:min:Measure :: Int
min     = forall a. Ord a => a -> a -> a
P.min Int
aMin (Int
bMin forall a. Num a => a -> a -> a
+ Int
aExcess)
    , $sel:excess:Measure :: Int
excess  = Int
aExcess forall a. Num a => a -> a -> a
+ Int
bExcess
    }

instance Monoid Measure where
  mempty :: Measure
mempty = Count -> Int -> Int -> Measure
Measure Count
0 Int
0 Int
0
#if MIN_VERSION_GLASGOW_HASKELL(8, 4, 4, 0)
#else
  mappend = (<>)
#endif

instance FT.Measured Measure Elem where
  measure :: Elem -> Measure
measure (Elem Count
w Count
size) = Measure { Int
min :: Int
$sel:min:Measure :: Int
min, Int
excess :: Int
$sel:excess:Measure :: Int
excess, Count
size :: Count
$sel:size:Measure :: Count
size }
    where MinExcess Int
min Int
excess = forall a. PartialMinExcess1 a => Int -> a -> MinExcess
partialMinExcess1 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Count
size) Count
w

instance HW.Container ParensSeq where
  type Elem ParensSeq = Bool

instance HW.Cons ParensSeq where
  cons :: Elem ParensSeq -> ParensSeq -> ParensSeq
cons Elem ParensSeq
b (ParensSeq ParensSeqFt
ft) = ParensSeqFt -> ParensSeq
ParensSeq forall a b. (a -> b) -> a -> b
$ case forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl ParensSeqFt
ft of
    Elem Count
w Count
nw :< ParensSeqFt
rt -> if Count
nw forall a. Ord a => a -> a -> Bool
>= Count
0 Bool -> Bool -> Bool
&& Count
nw forall a. Ord a => a -> a -> Bool
< Count
64
      then Count -> Count -> Elem
Elem ((Count
w forall a. Shift a => a -> Count -> a
.<. Count
1) forall a. BitWise a => a -> a -> a
.|. Count
bw) (Count
nw forall a. Num a => a -> a -> a
+ Count
1) forall v. Cons v => Elem v -> v -> v
<| ParensSeqFt
rt
      else Count -> Count -> Elem
Elem Count
bw Count
1                        forall v. Cons v => Elem v -> v -> v
<| ParensSeqFt
ft
    ViewL (FingerTree Measure) Elem
FT.EmptyL        -> forall v a. Measured v a => a -> FingerTree v a
FT.singleton (Count -> Count -> Elem
Elem Count
bw Count
1)
    where bw :: Count
bw = if Elem ParensSeq
b then Count
1 else Count
0

instance HW.Snoc ParensSeq where
  snoc :: ParensSeq -> Elem ParensSeq -> ParensSeq
snoc (ParensSeq ParensSeqFt
ft) Elem ParensSeq
b = ParensSeqFt -> ParensSeq
ParensSeq forall a b. (a -> b) -> a -> b
$ case forall v a.
Measured v a =>
FingerTree v a -> ViewR (FingerTree v) a
FT.viewr ParensSeqFt
ft of
    ParensSeqFt
lt :> Elem Count
w Count
nw -> if Count
nw forall a. Ord a => a -> a -> Bool
>= Count
0 Bool -> Bool -> Bool
&& Count
nw forall a. Ord a => a -> a -> Bool
< Count
64
      then Count -> Count -> Elem
Elem (Count
w forall a. BitWise a => a -> a -> a
.|. (Count
bw forall a. Shift a => a -> Count -> a
.<. Count
nw)) (Count
nw forall a. Num a => a -> a -> a
+ Count
1) forall v. Cons v => Elem v -> v -> v
<| ParensSeqFt
lt
      else Count -> Count -> Elem
Elem Count
bw Count
1                         forall v. Cons v => Elem v -> v -> v
<| ParensSeqFt
lt
    ViewR (FingerTree Measure) Elem
FT.EmptyR        -> forall v a. Measured v a => a -> FingerTree v a
FT.singleton (Count -> Count -> Elem
Elem Count
bw Count
1)
    where bw :: Count
bw = if Elem ParensSeq
b then Count
1 else Count
0

instance Semigroup ParensSeq where
  ParensSeq ParensSeqFt
tl <> :: ParensSeq -> ParensSeq -> ParensSeq
<> ParensSeq ParensSeqFt
tr = ParensSeqFt -> ParensSeq
ParensSeq forall a b. (a -> b) -> a -> b
$ case forall v a.
Measured v a =>
FingerTree v a -> ViewR (FingerTree v) a
FT.viewr ParensSeqFt
tl of
    ParensSeqFt
tll :> Elem Count
wl Count
nwl -> case forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl ParensSeqFt
tr of
      Elem Count
wr Count
nwr :< ParensSeqFt
trr -> let nw :: Count
nw = Count
nwl forall a. Num a => a -> a -> a
+ Count
nwr in if Count
nw forall a. Ord a => a -> a -> Bool
<= Count
64
        then (ParensSeqFt
tll forall v. Snoc v => v -> Elem v -> v
|> Count -> Count -> Elem
Elem (Count
wl forall a. BitWise a => a -> a -> a
.|. (Count
wr forall a. Shift a => a -> Count -> a
.<. Count
nwl)) Count
nw) forall v. (Semigroup v, Container v) => v -> v -> v
>< ParensSeqFt
trr
        else ParensSeqFt
tl forall v. (Semigroup v, Container v) => v -> v -> v
>< ParensSeqFt
tr
      ViewL (FingerTree Measure) Elem
FT.EmptyL -> ParensSeqFt
tr
    ViewR (FingerTree Measure) Elem
FT.EmptyR -> forall v a. Measured v a => FingerTree v a
FT.empty

(|>#) :: ParensSeqFt -> Elem -> ParensSeqFt
|># :: ParensSeqFt -> Elem -> ParensSeqFt
(|>#) ParensSeqFt
ft e :: Elem
e@(Elem Count
_ Count
wn) = if Count
wn forall a. Ord a => a -> a -> Bool
> Count
0 then ParensSeqFt
ft forall v. Snoc v => v -> Elem v -> v
|> Elem
e else ParensSeqFt
ft

(#<|) :: Elem ->ParensSeqFt -> ParensSeqFt
#<| :: Elem -> ParensSeqFt -> ParensSeqFt
(#<|) e :: Elem
e@(Elem Count
_ Count
wn) ParensSeqFt
ft = if Count
wn forall a. Ord a => a -> a -> Bool
> Count
0 then Elem
e forall v. Cons v => Elem v -> v -> v
<| ParensSeqFt
ft else ParensSeqFt
ft

ftSplit :: (Measure -> Bool) -> ParensSeqFt -> (ParensSeqFt, ParensSeqFt)
ftSplit :: (Measure -> Bool) -> ParensSeqFt -> (ParensSeqFt, ParensSeqFt)
ftSplit Measure -> Bool
p ParensSeqFt
ft = case forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl ParensSeqFt
rt of
  Elem Count
w Count
nw :< ParensSeqFt
rrt -> let c :: Count
c = Count -> Count -> Count -> Count
go Count
w Count
nw Count
nw in (ParensSeqFt
lt ParensSeqFt -> Elem -> ParensSeqFt
|># Count -> Count -> Elem
Elem Count
w Count
c, Count -> Count -> Elem
Elem (Count
w forall a. Shift a => a -> Count -> a
.>. Count
c) (Count
nw forall a. Num a => a -> a -> a
- Count
c) Elem -> ParensSeqFt -> ParensSeqFt
#<| ParensSeqFt
rrt)
  ViewL (FingerTree Measure) Elem
FT.EmptyL        -> (ParensSeqFt
ft, forall v a. Measured v a => FingerTree v a
FT.empty)
  where (ParensSeqFt
lt, ParensSeqFt
rt) = forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
FT.split Measure -> Bool
p ParensSeqFt
ft
        ltm :: Measure
ltm = forall v a. Measured v a => a -> v
FT.measure ParensSeqFt
lt
        go :: Word64 -> Count -> Count -> Count
        go :: Count -> Count -> Count -> Count
go Count
w Count
c Count
nw = if Count
c forall a. Ord a => a -> a -> Bool
> Count
0
          then if Measure -> Bool
p (Measure
ltm forall a. Semigroup a => a -> a -> a
<> forall v a. Measured v a => a -> v
FT.measure (Count -> Count -> Elem
Elem (Count
w forall a. Shift a => a -> Count -> a
.<. (Count
64 forall a. Num a => a -> a -> a
- Count
c) forall a. Shift a => a -> Count -> a
.>. (Count
64 forall a. Num a => a -> a -> a
- Count
c)) Count
c))
            then Count -> Count -> Count -> Count
go Count
w (Count
c forall a. Num a => a -> a -> a
- Count
1) Count
nw
            else Count
c
          else Count
0

atSizeBelowZero :: Count -> Measure -> Bool
atSizeBelowZero :: Count -> Measure -> Bool
atSizeBelowZero Count
n (Measure { $sel:size:Measure :: Measure -> Count
size = Count
sz }) = Count
n forall a. Ord a => a -> a -> Bool
< Count
sz

atMinZero :: Measure -> Bool
atMinZero :: Measure -> Bool
atMinZero (Measure { $sel:min:Measure :: Measure -> Int
min = Int
m }) = Int
m forall a. Ord a => a -> a -> Bool
<= Int
0