{-# 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 -> Word64
bps  :: {-# UNPACK #-} !Word64
  , Elem -> Word64
size :: {-# UNPACK #-} !Count
  } deriving (Elem -> Elem -> Bool
(Elem -> Elem -> Bool) -> (Elem -> Elem -> Bool) -> Eq Elem
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
(Int -> Elem -> ShowS)
-> (Elem -> String) -> ([Elem] -> ShowS) -> Show Elem
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. Elem -> Rep Elem x)
-> (forall x. Rep Elem x -> Elem) -> Generic Elem
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 -> Word64
size   :: {-# UNPACK #-} !Count
  , Measure -> Int
min    :: {-# UNPACK #-} !Int
  , Measure -> Int
excess :: {-# UNPACK #-} !Int
  } deriving (Measure -> Measure -> Bool
(Measure -> Measure -> Bool)
-> (Measure -> Measure -> Bool) -> Eq Measure
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
Eq Measure
-> (Measure -> Measure -> Ordering)
-> (Measure -> Measure -> Bool)
-> (Measure -> Measure -> Bool)
-> (Measure -> Measure -> Bool)
-> (Measure -> Measure -> Bool)
-> (Measure -> Measure -> Measure)
-> (Measure -> Measure -> Measure)
-> Ord 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
$cp1Ord :: Eq Measure
Ord, Int -> Measure -> ShowS
[Measure] -> ShowS
Measure -> String
(Int -> Measure -> ShowS)
-> (Measure -> String) -> ([Measure] -> ShowS) -> Show Measure
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. Measure -> Rep Measure x)
-> (forall x. Rep Measure x -> Measure) -> Generic Measure
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
(Int -> ParensSeq -> ShowS)
-> (ParensSeq -> String)
-> ([ParensSeq] -> ShowS)
-> Show ParensSeq
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 -> ()
(ParensSeq -> ()) -> NFData ParensSeq
forall a. (a -> ()) -> NFData a
rnf :: ParensSeq -> ()
$crnf :: ParensSeq -> ()
NFData, (forall x. ParensSeq -> Rep ParensSeq x)
-> (forall x. Rep ParensSeq x -> ParensSeq) -> Generic ParensSeq
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 Word64
aSize Int
aMin Int
aExcess <> :: Measure -> Measure -> Measure
<> Measure Word64
bSize Int
bMin Int
bExcess = Measure :: Word64 -> Int -> Int -> Measure
Measure
    { $sel:size:Measure :: Word64
size    = Word64
aSize Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
bSize
    , $sel:min:Measure :: Int
min     = Int -> Int -> Int
forall a. Ord a => a -> a -> a
P.min Int
aMin (Int
bMin Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
aExcess)
    , $sel:excess:Measure :: Int
excess  = Int
aExcess Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bExcess
    }

instance Monoid Measure where
  mempty :: Measure
mempty = Word64 -> Int -> Int -> Measure
Measure Word64
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 Word64
w Word64
size) = Measure :: Word64 -> Int -> Int -> Measure
Measure { Int
min :: Int
$sel:min:Measure :: Int
min, Int
excess :: Int
$sel:excess:Measure :: Int
excess, Word64
size :: Word64
$sel:size:Measure :: Word64
size }
    where MinExcess Int
min Int
excess = Int -> Word64 -> MinExcess
forall a. PartialMinExcess1 a => Int -> a -> MinExcess
partialMinExcess1 (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
size) Word64
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 (ParensSeqFt -> ParensSeq) -> ParensSeqFt -> ParensSeq
forall a b. (a -> b) -> a -> b
$ case ParensSeqFt -> ViewL (FingerTree Measure) Elem
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl ParensSeqFt
ft of
    Elem Word64
w Word64
nw :< ParensSeqFt
rt -> if Word64
nw Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
0 Bool -> Bool -> Bool
&& Word64
nw Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
64
      then Word64 -> Word64 -> Elem
Elem ((Word64
w Word64 -> Word64 -> Word64
forall a. Shift a => a -> Word64 -> a
.<. Word64
1) Word64 -> Word64 -> Word64
forall a. BitWise a => a -> a -> a
.|. Word64
bw) (Word64
nw Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) Elem ParensSeqFt -> ParensSeqFt -> ParensSeqFt
forall v. Cons v => Elem v -> v -> v
<| ParensSeqFt
rt
      else Word64 -> Word64 -> Elem
Elem Word64
bw Word64
1                        Elem ParensSeqFt -> ParensSeqFt -> ParensSeqFt
forall v. Cons v => Elem v -> v -> v
<| ParensSeqFt
ft
    ViewL (FingerTree Measure) Elem
FT.EmptyL        -> Elem -> ParensSeqFt
forall v a. Measured v a => a -> FingerTree v a
FT.singleton (Word64 -> Word64 -> Elem
Elem Word64
bw Word64
1)
    where bw :: Word64
bw = if Bool
Elem ParensSeq
b then Word64
1 else Word64
0

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

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

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

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

atSizeBelowZero :: Count -> Measure -> Bool
atSizeBelowZero :: Word64 -> Measure -> Bool
atSizeBelowZero Word64
n Measure
m = Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Measure -> Word64
size (Measure
m :: Measure)

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