-- | These were used in an earlier version of the enumeration algorithm, but no longer.
--
--   They are being kept around just in case.


module Data.ECTA.Internal.Paths.Zipper (
    unionPathTrie

  , InvertedPathTrie(..)

  , PathTrieZipper(..)
  , emptyPathTrieZipper
  , pathTrieToZipper
  , zipperCurPathTrie
  , pathTrieZipperDescend
  , pathTrieZipperAscend
  , unionPathTrieZipper
  ) where

import qualified Data.Vector as Vector
import qualified Data.Vector.Mutable as Vector ( unsafeWrite )

import GHC.Exts ( inline )

import Data.ECTA.Internal.Paths

-----------------------------------------------------------------------

---------------------
------- Path trie union
------- (7/9/21: only used as utility for unionPathTrieZipper)
---------------------

unionPathTrie :: PathTrie -> PathTrie -> Maybe PathTrie
unionPathTrie :: PathTrie -> PathTrie -> Maybe PathTrie
unionPathTrie PathTrie
EmptyPathTrie                PathTrie
pt                           = PathTrie -> Maybe PathTrie
forall a. a -> Maybe a
Just PathTrie
pt
unionPathTrie PathTrie
pt                           PathTrie
EmptyPathTrie                = PathTrie -> Maybe PathTrie
forall a. a -> Maybe a
Just PathTrie
pt
unionPathTrie PathTrie
TerminalPathTrie             PathTrie
TerminalPathTrie             = PathTrie -> Maybe PathTrie
forall a. a -> Maybe a
Just PathTrie
TerminalPathTrie
unionPathTrie PathTrie
TerminalPathTrie             PathTrie
_                            = Maybe PathTrie
forall a. Maybe a
Nothing
unionPathTrie PathTrie
_                            PathTrie
TerminalPathTrie             = Maybe PathTrie
forall a. Maybe a
Nothing
unionPathTrie (PathTrieSingleChild Int
i1 PathTrie
pt1) (PathTrieSingleChild Int
i2 PathTrie
pt2) =
    if Int
i1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i2 then
      Int -> PathTrie -> PathTrie
PathTrieSingleChild Int
i1 (PathTrie -> PathTrie) -> Maybe PathTrie -> Maybe PathTrie
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PathTrie -> PathTrie -> Maybe PathTrie
unionPathTrie PathTrie
pt1 PathTrie
pt2
    else
      PathTrie -> Maybe PathTrie
forall a. a -> Maybe a
Just (PathTrie -> Maybe PathTrie) -> PathTrie -> Maybe PathTrie
forall a b. (a -> b) -> a -> b
$ Vector PathTrie -> PathTrie
PathTrie (Vector PathTrie -> PathTrie) -> Vector PathTrie -> PathTrie
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> PathTrie) -> Vector PathTrie
forall a. Int -> (Int -> a) -> Vector a
Vector.generate (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
i1 Int
i2) ((Int -> PathTrie) -> Vector PathTrie)
-> (Int -> PathTrie) -> Vector PathTrie
forall a b. (a -> b) -> a -> b
$ \Int
j -> if Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i1 then
                                                                  PathTrie
pt1
                                                                else if Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i2 then
                                                                  PathTrie
pt2
                                                                else
                                                                  PathTrie
EmptyPathTrie
unionPathTrie (PathTrieSingleChild Int
i PathTrie
pt)   (PathTrie Vector PathTrie
vec) =
  if Vector PathTrie -> Int
forall a. Vector a -> Int
Vector.length Vector PathTrie
vec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i then
    do PathTrie
updated <- PathTrie -> PathTrie -> Maybe PathTrie
unionPathTrie PathTrie
pt (Vector PathTrie
vec Vector PathTrie -> Int -> PathTrie
forall a. Vector a -> Int -> a
`Vector.unsafeIndex` Int
i)
       PathTrie -> Maybe PathTrie
forall a. a -> Maybe a
Just (PathTrie -> Maybe PathTrie) -> PathTrie -> Maybe PathTrie
forall a b. (a -> b) -> a -> b
$ Vector PathTrie -> PathTrie
PathTrie (Vector PathTrie -> PathTrie) -> Vector PathTrie -> PathTrie
forall a b. (a -> b) -> a -> b
$ (forall s. MVector s PathTrie -> ST s ())
-> Vector PathTrie -> Vector PathTrie
forall a.
(forall s. MVector s a -> ST s ()) -> Vector a -> Vector a
Vector.modify (\MVector s PathTrie
v -> MVector (PrimState (ST s)) PathTrie -> Int -> PathTrie -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
Vector.unsafeWrite MVector s PathTrie
MVector (PrimState (ST s)) PathTrie
v Int
i PathTrie
updated) Vector PathTrie
vec
  else
    PathTrie -> Maybe PathTrie
forall a. a -> Maybe a
Just (PathTrie -> Maybe PathTrie) -> PathTrie -> Maybe PathTrie
forall a b. (a -> b) -> a -> b
$ Vector PathTrie -> PathTrie
PathTrie (Vector PathTrie -> PathTrie) -> Vector PathTrie -> PathTrie
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> PathTrie) -> Vector PathTrie
forall a. Int -> (Int -> a) -> Vector a
Vector.generate (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ((Int -> PathTrie) -> Vector PathTrie)
-> (Int -> PathTrie) -> Vector PathTrie
forall a b. (a -> b) -> a -> b
$ \Int
j -> if Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Vector PathTrie -> Int
forall a. Vector a -> Int
Vector.length Vector PathTrie
vec then
                                                      Vector PathTrie
vec Vector PathTrie -> Int -> PathTrie
forall a. Vector a -> Int -> a
`Vector.unsafeIndex` Int
j
                                                    else if Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i then
                                                      PathTrie
pt
                                                    else
                                                      PathTrie
EmptyPathTrie


unionPathTrie pt1 :: PathTrie
pt1@(PathTrie Vector PathTrie
_)             pt2 :: PathTrie
pt2@(PathTrieSingleChild Int
_ PathTrie
_) = (PathTrie -> PathTrie -> Maybe PathTrie)
-> PathTrie -> PathTrie -> Maybe PathTrie
forall a. a -> a
inline PathTrie -> PathTrie -> Maybe PathTrie
unionPathTrie PathTrie
pt2 PathTrie
pt1 -- TODO: Check whether this inlining is effective
unionPathTrie (PathTrie Vector PathTrie
vec1)              (PathTrie Vector PathTrie
vec2)               =
  let newLength :: Int
newLength = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Vector PathTrie -> Int
forall a. Vector a -> Int
Vector.length Vector PathTrie
vec1) (Vector PathTrie -> Int
forall a. Vector a -> Int
Vector.length Vector PathTrie
vec2)
      smallerLength :: Int
smallerLength = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Vector PathTrie -> Int
forall a. Vector a -> Int
Vector.length Vector PathTrie
vec1) (Vector PathTrie -> Int
forall a. Vector a -> Int
Vector.length Vector PathTrie
vec2)
      bigVec :: Vector PathTrie
bigVec   = if Vector PathTrie -> Int
forall a. Vector a -> Int
Vector.length Vector PathTrie
vec1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Vector PathTrie -> Int
forall a. Vector a -> Int
Vector.length Vector PathTrie
vec2 then Vector PathTrie
vec1 else Vector PathTrie
vec2
      smallVec :: Vector PathTrie
smallVec = if Vector PathTrie -> Int
forall a. Vector a -> Int
Vector.length Vector PathTrie
vec1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Vector PathTrie -> Int
forall a. Vector a -> Int
Vector.length Vector PathTrie
vec2 then Vector PathTrie
vec2 else Vector PathTrie
vec1
  in (Vector PathTrie -> PathTrie)
-> Maybe (Vector PathTrie) -> Maybe PathTrie
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector PathTrie -> PathTrie
PathTrie (Maybe (Vector PathTrie) -> Maybe PathTrie)
-> Maybe (Vector PathTrie) -> Maybe PathTrie
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Maybe PathTrie) -> Maybe (Vector PathTrie)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
Vector.generateM Int
newLength ((Int -> Maybe PathTrie) -> Maybe (Vector PathTrie))
-> (Int -> Maybe PathTrie) -> Maybe (Vector PathTrie)
forall a b. (a -> b) -> a -> b
$ \Int
i -> if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
smallerLength then
                                                          PathTrie -> Maybe PathTrie
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector PathTrie
bigVec Vector PathTrie -> Int -> PathTrie
forall a. Vector a -> Int -> a
`Vector.unsafeIndex` Int
i)
                                                        else
                                                          PathTrie -> PathTrie -> Maybe PathTrie
unionPathTrie (Vector PathTrie
bigVec Vector PathTrie -> Int -> PathTrie
forall a. Vector a -> Int -> a
`Vector.unsafeIndex` Int
i) (Vector PathTrie
smallVec Vector PathTrie -> Int -> PathTrie
forall a. Vector a -> Int -> a
`Vector.unsafeIndex` Int
i)



---------------------
------- Zippers
---------------------

data InvertedPathTrie = PathZipperRoot
                      | PathTrieAt {-# UNPACK #-} !Int !PathTrie !InvertedPathTrie
  deriving ( InvertedPathTrie -> InvertedPathTrie -> Bool
(InvertedPathTrie -> InvertedPathTrie -> Bool)
-> (InvertedPathTrie -> InvertedPathTrie -> Bool)
-> Eq InvertedPathTrie
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvertedPathTrie -> InvertedPathTrie -> Bool
$c/= :: InvertedPathTrie -> InvertedPathTrie -> Bool
== :: InvertedPathTrie -> InvertedPathTrie -> Bool
$c== :: InvertedPathTrie -> InvertedPathTrie -> Bool
Eq, Eq InvertedPathTrie
Eq InvertedPathTrie
-> (InvertedPathTrie -> InvertedPathTrie -> Ordering)
-> (InvertedPathTrie -> InvertedPathTrie -> Bool)
-> (InvertedPathTrie -> InvertedPathTrie -> Bool)
-> (InvertedPathTrie -> InvertedPathTrie -> Bool)
-> (InvertedPathTrie -> InvertedPathTrie -> Bool)
-> (InvertedPathTrie -> InvertedPathTrie -> InvertedPathTrie)
-> (InvertedPathTrie -> InvertedPathTrie -> InvertedPathTrie)
-> Ord InvertedPathTrie
InvertedPathTrie -> InvertedPathTrie -> Bool
InvertedPathTrie -> InvertedPathTrie -> Ordering
InvertedPathTrie -> InvertedPathTrie -> InvertedPathTrie
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 :: InvertedPathTrie -> InvertedPathTrie -> InvertedPathTrie
$cmin :: InvertedPathTrie -> InvertedPathTrie -> InvertedPathTrie
max :: InvertedPathTrie -> InvertedPathTrie -> InvertedPathTrie
$cmax :: InvertedPathTrie -> InvertedPathTrie -> InvertedPathTrie
>= :: InvertedPathTrie -> InvertedPathTrie -> Bool
$c>= :: InvertedPathTrie -> InvertedPathTrie -> Bool
> :: InvertedPathTrie -> InvertedPathTrie -> Bool
$c> :: InvertedPathTrie -> InvertedPathTrie -> Bool
<= :: InvertedPathTrie -> InvertedPathTrie -> Bool
$c<= :: InvertedPathTrie -> InvertedPathTrie -> Bool
< :: InvertedPathTrie -> InvertedPathTrie -> Bool
$c< :: InvertedPathTrie -> InvertedPathTrie -> Bool
compare :: InvertedPathTrie -> InvertedPathTrie -> Ordering
$ccompare :: InvertedPathTrie -> InvertedPathTrie -> Ordering
$cp1Ord :: Eq InvertedPathTrie
Ord, Int -> InvertedPathTrie -> ShowS
[InvertedPathTrie] -> ShowS
InvertedPathTrie -> String
(Int -> InvertedPathTrie -> ShowS)
-> (InvertedPathTrie -> String)
-> ([InvertedPathTrie] -> ShowS)
-> Show InvertedPathTrie
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvertedPathTrie] -> ShowS
$cshowList :: [InvertedPathTrie] -> ShowS
show :: InvertedPathTrie -> String
$cshow :: InvertedPathTrie -> String
showsPrec :: Int -> InvertedPathTrie -> ShowS
$cshowsPrec :: Int -> InvertedPathTrie -> ShowS
Show )

data PathTrieZipper = PathTrieZipper !PathTrie !InvertedPathTrie
  deriving ( PathTrieZipper -> PathTrieZipper -> Bool
(PathTrieZipper -> PathTrieZipper -> Bool)
-> (PathTrieZipper -> PathTrieZipper -> Bool) -> Eq PathTrieZipper
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathTrieZipper -> PathTrieZipper -> Bool
$c/= :: PathTrieZipper -> PathTrieZipper -> Bool
== :: PathTrieZipper -> PathTrieZipper -> Bool
$c== :: PathTrieZipper -> PathTrieZipper -> Bool
Eq, Eq PathTrieZipper
Eq PathTrieZipper
-> (PathTrieZipper -> PathTrieZipper -> Ordering)
-> (PathTrieZipper -> PathTrieZipper -> Bool)
-> (PathTrieZipper -> PathTrieZipper -> Bool)
-> (PathTrieZipper -> PathTrieZipper -> Bool)
-> (PathTrieZipper -> PathTrieZipper -> Bool)
-> (PathTrieZipper -> PathTrieZipper -> PathTrieZipper)
-> (PathTrieZipper -> PathTrieZipper -> PathTrieZipper)
-> Ord PathTrieZipper
PathTrieZipper -> PathTrieZipper -> Bool
PathTrieZipper -> PathTrieZipper -> Ordering
PathTrieZipper -> PathTrieZipper -> PathTrieZipper
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 :: PathTrieZipper -> PathTrieZipper -> PathTrieZipper
$cmin :: PathTrieZipper -> PathTrieZipper -> PathTrieZipper
max :: PathTrieZipper -> PathTrieZipper -> PathTrieZipper
$cmax :: PathTrieZipper -> PathTrieZipper -> PathTrieZipper
>= :: PathTrieZipper -> PathTrieZipper -> Bool
$c>= :: PathTrieZipper -> PathTrieZipper -> Bool
> :: PathTrieZipper -> PathTrieZipper -> Bool
$c> :: PathTrieZipper -> PathTrieZipper -> Bool
<= :: PathTrieZipper -> PathTrieZipper -> Bool
$c<= :: PathTrieZipper -> PathTrieZipper -> Bool
< :: PathTrieZipper -> PathTrieZipper -> Bool
$c< :: PathTrieZipper -> PathTrieZipper -> Bool
compare :: PathTrieZipper -> PathTrieZipper -> Ordering
$ccompare :: PathTrieZipper -> PathTrieZipper -> Ordering
$cp1Ord :: Eq PathTrieZipper
Ord, Int -> PathTrieZipper -> ShowS
[PathTrieZipper] -> ShowS
PathTrieZipper -> String
(Int -> PathTrieZipper -> ShowS)
-> (PathTrieZipper -> String)
-> ([PathTrieZipper] -> ShowS)
-> Show PathTrieZipper
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathTrieZipper] -> ShowS
$cshowList :: [PathTrieZipper] -> ShowS
show :: PathTrieZipper -> String
$cshow :: PathTrieZipper -> String
showsPrec :: Int -> PathTrieZipper -> ShowS
$cshowsPrec :: Int -> PathTrieZipper -> ShowS
Show )

emptyPathTrieZipper :: PathTrieZipper
emptyPathTrieZipper :: PathTrieZipper
emptyPathTrieZipper = PathTrie -> InvertedPathTrie -> PathTrieZipper
PathTrieZipper PathTrie
EmptyPathTrie InvertedPathTrie
PathZipperRoot

pathTrieToZipper :: PathTrie -> PathTrieZipper
pathTrieToZipper :: PathTrie -> PathTrieZipper
pathTrieToZipper PathTrie
pt = PathTrie -> InvertedPathTrie -> PathTrieZipper
PathTrieZipper PathTrie
pt InvertedPathTrie
PathZipperRoot

zipperCurPathTrie :: PathTrieZipper -> PathTrie
zipperCurPathTrie :: PathTrieZipper -> PathTrie
zipperCurPathTrie (PathTrieZipper PathTrie
pt InvertedPathTrie
_) = PathTrie
pt

unionInvertedPathTrie :: InvertedPathTrie -> InvertedPathTrie -> Maybe InvertedPathTrie
unionInvertedPathTrie :: InvertedPathTrie -> InvertedPathTrie -> Maybe InvertedPathTrie
unionInvertedPathTrie InvertedPathTrie
PathZipperRoot           InvertedPathTrie
ipt                      = InvertedPathTrie -> Maybe InvertedPathTrie
forall a. a -> Maybe a
Just InvertedPathTrie
ipt
unionInvertedPathTrie InvertedPathTrie
ipt                      InvertedPathTrie
PathZipperRoot           = InvertedPathTrie -> Maybe InvertedPathTrie
forall a. a -> Maybe a
Just InvertedPathTrie
ipt
unionInvertedPathTrie (PathTrieAt Int
i1 PathTrie
pt1 InvertedPathTrie
ipt1) (PathTrieAt Int
i2 PathTrie
pt2 InvertedPathTrie
ipt2) =
  if Int
i1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
i2 then
    Maybe InvertedPathTrie
forall a. Maybe a
Nothing
  else
    Int -> PathTrie -> InvertedPathTrie -> InvertedPathTrie
PathTrieAt Int
i1 (PathTrie -> InvertedPathTrie -> InvertedPathTrie)
-> Maybe PathTrie -> Maybe (InvertedPathTrie -> InvertedPathTrie)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PathTrie -> PathTrie -> Maybe PathTrie
unionPathTrie PathTrie
pt1 PathTrie
pt2 Maybe (InvertedPathTrie -> InvertedPathTrie)
-> Maybe InvertedPathTrie -> Maybe InvertedPathTrie
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InvertedPathTrie -> InvertedPathTrie -> Maybe InvertedPathTrie
unionInvertedPathTrie InvertedPathTrie
ipt1 InvertedPathTrie
ipt2


unionPathTrieZipper :: PathTrieZipper -> PathTrieZipper -> Maybe PathTrieZipper
unionPathTrieZipper :: PathTrieZipper -> PathTrieZipper -> Maybe PathTrieZipper
unionPathTrieZipper (PathTrieZipper PathTrie
pt1 InvertedPathTrie
ipt1) (PathTrieZipper PathTrie
pt2 InvertedPathTrie
ipt2) =
  PathTrie -> InvertedPathTrie -> PathTrieZipper
PathTrieZipper (PathTrie -> InvertedPathTrie -> PathTrieZipper)
-> Maybe PathTrie -> Maybe (InvertedPathTrie -> PathTrieZipper)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PathTrie -> PathTrie -> Maybe PathTrie
unionPathTrie PathTrie
pt1 PathTrie
pt2 Maybe (InvertedPathTrie -> PathTrieZipper)
-> Maybe InvertedPathTrie -> Maybe PathTrieZipper
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InvertedPathTrie -> InvertedPathTrie -> Maybe InvertedPathTrie
unionInvertedPathTrie InvertedPathTrie
ipt1 InvertedPathTrie
ipt2

pathTrieZipperDescend :: PathTrieZipper -> Int -> PathTrieZipper
pathTrieZipperDescend :: PathTrieZipper -> Int -> PathTrieZipper
pathTrieZipperDescend (PathTrieZipper PathTrie
pt InvertedPathTrie
z) Int
i = PathTrie -> InvertedPathTrie -> PathTrieZipper
PathTrieZipper (PathTrie -> Int -> PathTrie
pathTrieDescend PathTrie
pt Int
i) (Int -> PathTrie -> InvertedPathTrie -> InvertedPathTrie
PathTrieAt Int
i PathTrie
pt InvertedPathTrie
z)

-- | The semantics of this may not be what you expect: Path trie zippers do not support editing currently, only traversing.
--   The value at the cursor (as well as the index) is ignored except when traversing above the root, where it uses those
--   values to extend the path trie upwards.
pathTrieZipperAscend :: PathTrieZipper -> Int -> PathTrieZipper
pathTrieZipperAscend :: PathTrieZipper -> Int -> PathTrieZipper
pathTrieZipperAscend (PathTrieZipper PathTrie
pt InvertedPathTrie
PathZipperRoot)         Int
i = PathTrie -> InvertedPathTrie -> PathTrieZipper
PathTrieZipper (Int -> PathTrie -> PathTrie
PathTrieSingleChild Int
i PathTrie
pt) InvertedPathTrie
PathZipperRoot
pathTrieZipperAscend (PathTrieZipper PathTrie
_  (PathTrieAt Int
_ PathTrie
pt' InvertedPathTrie
ipt)) Int
_ = PathTrie -> InvertedPathTrie -> PathTrieZipper
PathTrieZipper PathTrie
pt'                        InvertedPathTrie
ipt