module StreamPatch.Patch.Linearize.Insert where

import Control.Monad.State
import Data.List qualified as List
import StreamPatch.Util ( traverseM )

{-
-- Result seeks are non-negative, so natural-like types are safe to use.
linearizeInsert
    :: (Integral sf, Integral st)
    => [Patch sf fs a] -> Either (Error (Patch sf fs a)) [Patch st fs a]
linearizeInsert = linearize patchSeek (\s p -> p { patchSeek = s })
-}

-- | Linearize some list of @a@s.
--
-- For non-empty lists, the result is a tuple of the first @a@, followed by the
-- linearized @a@s (converted to @b@). Linearized values are non-negative, so
-- natural-like types are safe to use for @st@.
linearize
    :: (Integral sf, Integral st)
    => (a -> sf)
    -> (st -> a -> b)
    -> [a] -> Either (a, a) (Maybe (a, [b]))
linearize :: forall sf st a b.
(Integral sf, Integral st) =>
(a -> sf)
-> (st -> a -> b) -> [a] -> Either (a, a) (Maybe (a, [b]))
linearize a -> sf
f st -> a -> b
g [a]
as =
    case (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy a -> a -> Ordering
cmp [a]
as of
      []      -> Maybe (a, [b]) -> Either (a, a) (Maybe (a, [b]))
forall a b. b -> Either a b
Right Maybe (a, [b])
forall a. Maybe a
Nothing
      (a
a:[a]
as') -> do
        [b]
bs <- State a (Either (a, a) [b]) -> a -> Either (a, a) [b]
forall s a. State s a -> s -> a
evalState ((a -> StateT a Identity (Either (a, a) b))
-> [a] -> State a (Either (a, a) [b])
forall (t :: * -> *) (f :: * -> *) (m :: * -> *) v v'.
(Traversable t, Applicative f, Monad m) =>
(v -> m (f v')) -> t v -> m (f (t v'))
traverseM a -> StateT a Identity (Either (a, a) b)
go [a]
as') a
a
        Maybe (a, [b]) -> Either (a, a) (Maybe (a, [b]))
forall a b. b -> Either a b
Right (Maybe (a, [b]) -> Either (a, a) (Maybe (a, [b])))
-> Maybe (a, [b]) -> Either (a, a) (Maybe (a, [b]))
forall a b. (a -> b) -> a -> b
$ (a, [b]) -> Maybe (a, [b])
forall a. a -> Maybe a
Just (a
a, [b]
bs)
  where
    cmp :: a -> a -> Ordering
cmp a
a1 a
a2 = sf -> sf -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> sf
f a
a1) (a -> sf
f a
a2)
    go :: a -> StateT a Identity (Either (a, a) b)
go a
a = do
        a
a' <- StateT a Identity a
forall s (m :: * -> *). MonadState s m => m s
get
        let s' :: st
s' = sf -> st
forall a b. (Integral a, Num b) => a -> b
fromIntegral (sf -> st) -> sf -> st
forall a b. (a -> b) -> a -> b
$ a -> sf
f a
a sf -> sf -> sf
forall a. Num a => a -> a -> a
- a -> sf
f a
a'
        if st
s' st -> st -> Bool
forall a. Eq a => a -> a -> Bool
== st
0
        then Either (a, a) b -> StateT a Identity (Either (a, a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (a, a) b -> StateT a Identity (Either (a, a) b))
-> Either (a, a) b -> StateT a Identity (Either (a, a) b)
forall a b. (a -> b) -> a -> b
$ (a, a) -> Either (a, a) b
forall a b. a -> Either a b
Left (a
a, a
a')
        else a -> StateT a Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put a
a StateT a Identity ()
-> StateT a Identity (Either (a, a) b)
-> StateT a Identity (Either (a, a) b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either (a, a) b -> StateT a Identity (Either (a, a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either (a, a) b
forall a b. b -> Either a b
Right (st -> a -> b
g st
s' a
a))

linearize' :: (Integral sf, Integral st) => [sf] -> Either (sf, sf) (Maybe (sf, [st]))
linearize' :: forall sf st.
(Integral sf, Integral st) =>
[sf] -> Either (sf, sf) (Maybe (sf, [st]))
linearize' = (sf -> sf)
-> (st -> sf -> st) -> [sf] -> Either (sf, sf) (Maybe (sf, [st]))
forall sf st a b.
(Integral sf, Integral st) =>
(a -> sf)
-> (st -> a -> b) -> [a] -> Either (a, a) (Maybe (a, [b]))
linearize sf -> sf
forall a. a -> a
id st -> sf -> st
forall a b. a -> b -> a
const