{-# LANGUAGE ScopedTypeVariables #-}

-- | Utilities on 'AnchoredSeq's.
module Ouroboros.Consensus.Util.AnchoredSeq
  ( takeLongestSuffix
  ) where

import Data.Maybe (fromMaybe)
import Ouroboros.Network.AnchoredSeq (AnchoredSeq)
import qualified Ouroboros.Network.AnchoredSeq as AS

-- | Take the longest suffix of an 'AnchoredSeq' @as@ satisfying the given
-- predicate @p@ on the monoidal summary given by @f@.
--
-- TODO: upstream this function
--
-- === PRECONDITIONS:
--
-- For @as0, as1@ such that @AS.join as0 as1 = Just as2@, we must have the
-- following homomorphism property:
--
-- > f as0 <> f as1 ≡ f as2
--
-- For empty @ase@, we must have @f ase ≡ mempty@.
--
-- The predicate must be monotonic, ie when @suf0@ is a suffix of @as@ and
-- @suf1@ is a suffix of @suf0@, then @p (f suf0)@ must imply @p (f suf1)@.
-- Furthermore, we must have @p mempty@.
takeLongestSuffix ::
  forall s v a b.
  (Monoid s, AS.Anchorable v a b) =>
  -- | @f@: Compute a monoidal summary of a fragment.
  (AnchoredSeq v a b -> s) ->
  -- | @p@: Predicate on the summary of a fragment.
  (s -> Bool) ->
  -- | Input sequence @as@.
  AnchoredSeq v a b ->
  -- | A suffix of the input sequence.
  AnchoredSeq v a b
takeLongestSuffix :: forall s v a b.
(Monoid s, Anchorable v a b) =>
(AnchoredSeq v a b -> s)
-> (s -> Bool) -> AnchoredSeq v a b -> AnchoredSeq v a b
takeLongestSuffix AnchoredSeq v a b -> s
f s -> Bool
p AnchoredSeq v a b
as =
  AnchoredSeq v a b -> s -> AnchoredSeq v a b -> AnchoredSeq v a b
go (a -> AnchoredSeq v a b
forall v a b. Anchorable v a b => a -> AnchoredSeq v a b
AS.Empty (a -> AnchoredSeq v a b) -> a -> AnchoredSeq v a b
forall a b. (a -> b) -> a -> b
$ AnchoredSeq v a b -> a
forall v a b. Anchorable v a b => AnchoredSeq v a b -> a
AS.headAnchor AnchoredSeq v a b
as) s
forall a. Monoid a => a
mempty AnchoredSeq v a b
as
 where
  go ::
    -- @suf@: the longest suffix of @as@ for which we currently know that @p (f
    -- suf)@.
    AnchoredSeq v a b ->
    -- Equal to @f suf@.
    s ->
    -- @pre@: longest infix of @as@ ending just before @suf@ such that we don't
    -- know whether @p (f (AS.join pre suf))@.
    AnchoredSeq v a b ->
    -- Longest suffix of @as@ satisfying @p . f@.
    AnchoredSeq v a b
  go :: AnchoredSeq v a b -> s -> AnchoredSeq v a b -> AnchoredSeq v a b
go AnchoredSeq v a b
suf s
sufS AnchoredSeq v a b
pre
    | AnchoredSeq v a b -> Bool
forall v a b. AnchoredSeq v a b -> Bool
AS.null AnchoredSeq v a b
pre = AnchoredSeq v a b
suf
    | s -> Bool
p s
suf'S = AnchoredSeq v a b -> s -> AnchoredSeq v a b -> AnchoredSeq v a b
go AnchoredSeq v a b
suf' s
suf'S AnchoredSeq v a b
pre0
    | AnchoredSeq v a b -> Bool
forall v a b. AnchoredSeq v a b -> Bool
AS.null AnchoredSeq v a b
pre0 = AnchoredSeq v a b
suf
    | Bool
otherwise = AnchoredSeq v a b -> s -> AnchoredSeq v a b -> AnchoredSeq v a b
go AnchoredSeq v a b
suf s
sufS AnchoredSeq v a b
pre1
   where
    (AnchoredSeq v a b
pre0, AnchoredSeq v a b
pre1) = Int -> AnchoredSeq v a b -> (AnchoredSeq v a b, AnchoredSeq v a b)
forall v a b.
Anchorable v a b =>
Int -> AnchoredSeq v a b -> (AnchoredSeq v a b, AnchoredSeq v a b)
AS.splitAt (AnchoredSeq v a b -> Int
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Int
AS.length AnchoredSeq v a b
pre Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) AnchoredSeq v a b
pre
    suf' :: AnchoredSeq v a b
suf' =
      AnchoredSeq v a b -> Maybe (AnchoredSeq v a b) -> AnchoredSeq v a b
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> AnchoredSeq v a b
forall a. HasCallStack => [Char] -> a
error [Char]
"takeLongestSuffix: internal invariant violation") (Maybe (AnchoredSeq v a b) -> AnchoredSeq v a b)
-> Maybe (AnchoredSeq v a b) -> AnchoredSeq v a b
forall a b. (a -> b) -> a -> b
$
        (Either a b -> a -> Bool)
-> AnchoredSeq v a b
-> AnchoredSeq v a b
-> Maybe (AnchoredSeq v a b)
forall v a b.
Anchorable v a b =>
(Either a b -> a -> Bool)
-> AnchoredSeq v a b
-> AnchoredSeq v a b
-> Maybe (AnchoredSeq v a b)
AS.join (\Either a b
_ a
_ -> Bool
True) AnchoredSeq v a b
pre1 AnchoredSeq v a b
suf
    suf'S :: s
suf'S = AnchoredSeq v a b -> s
f AnchoredSeq v a b
pre1 s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
sufS