{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ExistentialQuantification #-}
#ifdef TRUSTWORTHY
{-# LANGUAGE Trustworthy #-}
#endif
#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif
module Control.Zipper.Internal where
import Control.Applicative
import Control.Category ((>>>))
import Control.Monad
import qualified Control.Monad.Fail as Fail
import Control.Lens.Getter
import Control.Lens.Internal.Context
import Control.Lens.Internal.Indexed
import Control.Lens.Lens
import Control.Lens.Setter
import Control.Lens.Traversal
import Control.Lens.Type
import Data.Foldable.WithIndex
import Data.Functor.Apply
import Data.Functor.WithIndex
import Data.Maybe
import Data.Monoid (Last(..))
import Data.Profunctor.Unsafe
import Data.Traversable.WithIndex
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif
#if !MIN_VERSION_lens(5,0,0)
import qualified Control.Lens.Indexed as Lens
#endif
data Jacket i a
= Ap Int
Bool
Bool
(Last i)
(Jacket i a)
(Jacket i a)
| Leaf i a
| Pure
deriving Int -> Jacket i a -> ShowS
[Jacket i a] -> ShowS
Jacket i a -> String
(Int -> Jacket i a -> ShowS)
-> (Jacket i a -> String)
-> ([Jacket i a] -> ShowS)
-> Show (Jacket i a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall i a. (Show i, Show a) => Int -> Jacket i a -> ShowS
forall i a. (Show i, Show a) => [Jacket i a] -> ShowS
forall i a. (Show i, Show a) => Jacket i a -> String
showList :: [Jacket i a] -> ShowS
$cshowList :: forall i a. (Show i, Show a) => [Jacket i a] -> ShowS
show :: Jacket i a -> String
$cshow :: forall i a. (Show i, Show a) => Jacket i a -> String
showsPrec :: Int -> Jacket i a -> ShowS
$cshowsPrec :: forall i a. (Show i, Show a) => Int -> Jacket i a -> ShowS
Show
size :: Jacket i a -> Int
size :: Jacket i a -> Int
size (Ap Int
s Bool
_ Bool
_ Last i
_ Jacket i a
_ Jacket i a
_) = Int
s
size Leaf{} = Int
1
size Jacket i a
Pure = Int
0
{-# INLINE size #-}
nullLeft :: Jacket i a -> Bool
nullLeft :: Jacket i a -> Bool
nullLeft (Ap Int
_ Bool
nl Bool
_ Last i
_ Jacket i a
_ Jacket i a
_) = Bool
nl
nullLeft (Leaf i
_ a
_) = Bool
False
nullLeft Jacket i a
Pure = Bool
True
{-# INLINE nullLeft #-}
nullRight :: Jacket i a -> Bool
nullRight :: Jacket i a -> Bool
nullRight (Ap Int
_ Bool
_ Bool
nr Last i
_ Jacket i a
_ Jacket i a
_) = Bool
nr
nullRight (Leaf i
_ a
_) = Bool
False
nullRight Jacket i a
Pure = Bool
True
{-# INLINE nullRight #-}
maximal :: Jacket i a -> Last i
maximal :: Jacket i a -> Last i
maximal (Ap Int
_ Bool
_ Bool
_ Last i
li Jacket i a
_ Jacket i a
_) = Last i
li
maximal (Leaf i
i a
_) = Maybe i -> Last i
forall a. Maybe a -> Last a
Last (i -> Maybe i
forall a. a -> Maybe a
Just i
i)
maximal Jacket i a
Pure = Maybe i -> Last i
forall a. Maybe a -> Last a
Last Maybe i
forall a. Maybe a
Nothing
{-# INLINE maximal #-}
instance Functor (Jacket i) where
fmap :: (a -> b) -> Jacket i a -> Jacket i b
fmap a -> b
f (Ap Int
m Bool
nl Bool
nr Last i
li Jacket i a
l Jacket i a
r) = Int
-> Bool -> Bool -> Last i -> Jacket i b -> Jacket i b -> Jacket i b
forall i a.
Int
-> Bool -> Bool -> Last i -> Jacket i a -> Jacket i a -> Jacket i a
Ap Int
m Bool
nl Bool
nr Last i
li ((a -> b) -> Jacket i a -> Jacket i b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Jacket i a
l) ((a -> b) -> Jacket i a -> Jacket i b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Jacket i a
r)
fmap a -> b
f (Leaf i
i a
a) = i -> b -> Jacket i b
forall i a. i -> a -> Jacket i a
Leaf i
i (a -> b
f a
a)
fmap a -> b
_ Jacket i a
Pure = Jacket i b
forall i a. Jacket i a
Pure
{-# INLINE fmap #-}
instance Foldable (Jacket i) where
foldMap :: (a -> m) -> Jacket i a -> m
foldMap a -> m
f (Ap Int
_ Bool
_ Bool
_ Last i
_ Jacket i a
l Jacket i a
r) = (a -> m) -> Jacket i a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Jacket i a
l m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> Jacket i a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Jacket i a
r
foldMap a -> m
f (Leaf i
_ a
a) = a -> m
f a
a
foldMap a -> m
_ Jacket i a
Pure = m
forall a. Monoid a => a
mempty
{-# INLINE foldMap #-}
instance Traversable (Jacket i) where
traverse :: (a -> f b) -> Jacket i a -> f (Jacket i b)
traverse a -> f b
f (Ap Int
m Bool
nl Bool
nr Last i
li Jacket i a
l Jacket i a
r) = Int
-> Bool -> Bool -> Last i -> Jacket i b -> Jacket i b -> Jacket i b
forall i a.
Int
-> Bool -> Bool -> Last i -> Jacket i a -> Jacket i a -> Jacket i a
Ap Int
m Bool
nl Bool
nr Last i
li (Jacket i b -> Jacket i b -> Jacket i b)
-> f (Jacket i b) -> f (Jacket i b -> Jacket i b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Jacket i a -> f (Jacket i b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Jacket i a
l f (Jacket i b -> Jacket i b) -> f (Jacket i b) -> f (Jacket i b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Jacket i a -> f (Jacket i b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Jacket i a
r
traverse a -> f b
f (Leaf i
i a
a) = i -> b -> Jacket i b
forall i a. i -> a -> Jacket i a
Leaf i
i (b -> Jacket i b) -> f b -> f (Jacket i b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
traverse a -> f b
_ Jacket i a
Pure = Jacket i b -> f (Jacket i b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Jacket i b
forall i a. Jacket i a
Pure
{-# INLINE traverse #-}
instance FunctorWithIndex i (Jacket i) where
imap :: (i -> a -> b) -> Jacket i a -> Jacket i b
imap i -> a -> b
f = Jacket i a -> Jacket i b
go where
go :: Jacket i a -> Jacket i b
go (Ap Int
m Bool
nl Bool
nr Last i
li Jacket i a
l Jacket i a
r) = Int
-> Bool -> Bool -> Last i -> Jacket i b -> Jacket i b -> Jacket i b
forall i a.
Int
-> Bool -> Bool -> Last i -> Jacket i a -> Jacket i a -> Jacket i a
Ap Int
m Bool
nl Bool
nr Last i
li (Jacket i a -> Jacket i b
go Jacket i a
l) (Jacket i a -> Jacket i b
go Jacket i a
r)
go (Leaf i
i a
a) = i -> b -> Jacket i b
forall i a. i -> a -> Jacket i a
Leaf i
i (i -> a -> b
f i
i a
a)
go Jacket i a
Pure = Jacket i b
forall i a. Jacket i a
Pure
{-# INLINE imap #-}
instance FoldableWithIndex i (Jacket i) where
ifoldMap :: (i -> a -> m) -> Jacket i a -> m
ifoldMap i -> a -> m
f = Jacket i a -> m
go where
go :: Jacket i a -> m
go (Ap Int
_ Bool
_ Bool
_ Last i
_ Jacket i a
l Jacket i a
r) = Jacket i a -> m
go Jacket i a
l m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` Jacket i a -> m
go Jacket i a
r
go (Leaf i
i a
a) = i -> a -> m
f i
i a
a
go Jacket i a
Pure = m
forall a. Monoid a => a
mempty
{-# INLINE ifoldMap #-}
instance TraversableWithIndex i (Jacket i) where
itraverse :: (i -> a -> f b) -> Jacket i a -> f (Jacket i b)
itraverse i -> a -> f b
f = Jacket i a -> f (Jacket i b)
go where
go :: Jacket i a -> f (Jacket i b)
go (Ap Int
m Bool
nl Bool
nr Last i
li Jacket i a
l Jacket i a
r) = Int
-> Bool -> Bool -> Last i -> Jacket i b -> Jacket i b -> Jacket i b
forall i a.
Int
-> Bool -> Bool -> Last i -> Jacket i a -> Jacket i a -> Jacket i a
Ap Int
m Bool
nl Bool
nr Last i
li (Jacket i b -> Jacket i b -> Jacket i b)
-> f (Jacket i b) -> f (Jacket i b -> Jacket i b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Jacket i a -> f (Jacket i b)
go Jacket i a
l f (Jacket i b -> Jacket i b) -> f (Jacket i b) -> f (Jacket i b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Jacket i a -> f (Jacket i b)
go Jacket i a
r
go (Leaf i
i a
a) = i -> b -> Jacket i b
forall i a. i -> a -> Jacket i a
Leaf i
i (b -> Jacket i b) -> f b -> f (Jacket i b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i -> a -> f b
f i
i a
a
go Jacket i a
Pure = Jacket i b -> f (Jacket i b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Jacket i b
forall i a. Jacket i a
Pure
{-# INLINE itraverse #-}
#if !MIN_VERSION_lens(5,0,0)
instance Lens.FunctorWithIndex i (Jacket i) where imap = imap
instance Lens.FoldableWithIndex i (Jacket i) where ifoldMap = ifoldMap
instance Lens.TraversableWithIndex i (Jacket i) where itraverse = itraverse
#endif
instance Semigroup (Jacket i a) where
Jacket i a
l <> :: Jacket i a -> Jacket i a -> Jacket i a
<> Jacket i a
r = Int
-> Bool -> Bool -> Last i -> Jacket i a -> Jacket i a -> Jacket i a
forall i a.
Int
-> Bool -> Bool -> Last i -> Jacket i a -> Jacket i a -> Jacket i a
Ap (Jacket i a -> Int
forall i a. Jacket i a -> Int
size Jacket i a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Jacket i a -> Int
forall i a. Jacket i a -> Int
size Jacket i a
r) (Jacket i a -> Bool
forall i a. Jacket i a -> Bool
nullLeft Jacket i a
l Bool -> Bool -> Bool
&& Jacket i a -> Bool
forall i a. Jacket i a -> Bool
nullLeft Jacket i a
r) (Jacket i a -> Bool
forall i a. Jacket i a -> Bool
nullRight Jacket i a
r Bool -> Bool -> Bool
&& Jacket i a -> Bool
forall i a. Jacket i a -> Bool
nullRight Jacket i a
l) (Jacket i a -> Last i
forall i a. Jacket i a -> Last i
maximal Jacket i a
l Last i -> Last i -> Last i
forall a. Semigroup a => a -> a -> a
<> Jacket i a -> Last i
forall i a. Jacket i a -> Last i
maximal Jacket i a
r) Jacket i a
l Jacket i a
r
{-# INLINE (<>) #-}
instance Monoid (Jacket i a) where
mempty :: Jacket i a
mempty = Jacket i a
forall i a. Jacket i a
Pure
{-# INLINE mempty #-}
#if !(MIN_VERSION_base(4,11,0))
mappend = (<>)
{-# INLINE mappend #-}
#endif
jacketIns :: Bazaar (Indexed i) a b t -> Jacket i a
jacketIns :: Bazaar (Indexed i) a b t -> Jacket i a
jacketIns (Bazaar forall (f :: * -> *). Applicative f => Indexed i a (f b) -> f t
bz) = Const (Jacket i a) t -> Jacket i a
forall a k (b :: k). Const a b -> a
getConst (Const (Jacket i a) t -> Jacket i a)
-> Const (Jacket i a) t -> Jacket i a
forall a b. (a -> b) -> a -> b
$ Indexed i a (Const (Jacket i a) b) -> Const (Jacket i a) t
forall (f :: * -> *). Applicative f => Indexed i a (f b) -> f t
bz (Indexed i a (Const (Jacket i a) b) -> Const (Jacket i a) t)
-> Indexed i a (Const (Jacket i a) b) -> Const (Jacket i a) t
forall a b. (a -> b) -> a -> b
$ (i -> a -> Const (Jacket i a) b)
-> Indexed i a (Const (Jacket i a) b)
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed (\i
i -> Jacket i a -> Const (Jacket i a) b
forall k a (b :: k). a -> Const a b
Const (Jacket i a -> Const (Jacket i a) b)
-> (a -> Jacket i a) -> a -> Const (Jacket i a) b
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. i -> a -> Jacket i a
forall i a. i -> a -> Jacket i a
Leaf i
i)
{-# INLINE jacketIns #-}
newtype Flow i b a = Flow { Flow i b a -> Jacket i b -> a
runFlow :: Jacket i b -> a }
instance Functor (Flow i b) where
fmap :: (a -> b) -> Flow i b a -> Flow i b b
fmap a -> b
f (Flow Jacket i b -> a
g) = (Jacket i b -> b) -> Flow i b b
forall i b a. (Jacket i b -> a) -> Flow i b a
Flow (a -> b
f (a -> b) -> (Jacket i b -> a) -> Jacket i b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Jacket i b -> a
g)
{-# INLINE fmap #-}
instance Apply (Flow i b) where
<.> :: Flow i b (a -> b) -> Flow i b a -> Flow i b b
(<.>) = Flow i b (a -> b) -> Flow i b a -> Flow i b b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
{-# INLINE (<.>) #-}
instance Applicative (Flow i b) where
pure :: a -> Flow i b a
pure a
a = (Jacket i b -> a) -> Flow i b a
forall i b a. (Jacket i b -> a) -> Flow i b a
Flow (a -> Jacket i b -> a
forall a b. a -> b -> a
const a
a)
{-# INLINE pure #-}
Flow Jacket i b -> a -> b
mf <*> :: Flow i b (a -> b) -> Flow i b a -> Flow i b b
<*> Flow Jacket i b -> a
ma = (Jacket i b -> b) -> Flow i b b
forall i b a. (Jacket i b -> a) -> Flow i b a
Flow ((Jacket i b -> b) -> Flow i b b)
-> (Jacket i b -> b) -> Flow i b b
forall a b. (a -> b) -> a -> b
$ \ Jacket i b
s -> case Jacket i b
s of
Ap Int
_ Bool
_ Bool
_ Last i
_ Jacket i b
l Jacket i b
r -> Jacket i b -> a -> b
mf Jacket i b
l (Jacket i b -> a
ma Jacket i b
r)
Jacket i b
_ -> Jacket i b -> a -> b
mf Jacket i b
s (Jacket i b -> a
ma Jacket i b
s)
{-# INLINE (<*>) #-}
jacketOuts :: Bazaar (Indexed i) a b t -> Jacket j b -> t
jacketOuts :: Bazaar (Indexed i) a b t -> Jacket j b -> t
jacketOuts Bazaar (Indexed i) a b t
bz = Flow j b t -> Jacket j b -> t
forall i b a. Flow i b a -> Jacket i b -> a
runFlow (Flow j b t -> Jacket j b -> t) -> Flow j b t -> Jacket j b -> t
forall a b. (a -> b) -> a -> b
$ Bazaar (Indexed i) a b t
-> forall (f :: * -> *). Applicative f => Indexed i a (f b) -> f t
forall (p :: * -> * -> *) a b t.
Bazaar p a b t
-> forall (f :: * -> *). Applicative f => p a (f b) -> f t
runBazaar Bazaar (Indexed i) a b t
bz (Indexed i a (Flow j b b) -> Flow j b t)
-> Indexed i a (Flow j b b) -> Flow j b t
forall a b. (a -> b) -> a -> b
$ (i -> a -> Flow j b b) -> Indexed i a (Flow j b b)
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> a -> Flow j b b) -> Indexed i a (Flow j b b))
-> (i -> a -> Flow j b b) -> Indexed i a (Flow j b b)
forall a b. (a -> b) -> a -> b
$ \ i
_ a
_ -> (Jacket j b -> b) -> Flow j b b
forall i b a. (Jacket i b -> a) -> Flow i b a
Flow ((Jacket j b -> b) -> Flow j b b)
-> (Jacket j b -> b) -> Flow j b b
forall a b. (a -> b) -> a -> b
$ \ Jacket j b
t -> case Jacket j b
t of
Leaf j
_ b
a -> b
a
Jacket j b
_ -> String -> b
forall a. HasCallStack => String -> a
error String
"jacketOuts: wrong shape"
{-# INLINE jacketOuts #-}
jacket :: AnIndexedTraversal i s t a b -> Lens s t (Jacket i a) (Jacket j b)
jacket :: AnIndexedTraversal i s t a b -> Lens s t (Jacket i a) (Jacket j b)
jacket AnIndexedTraversal i s t a b
l Jacket i a -> f (Jacket j b)
f s
s = Bazaar (Indexed i) a b t -> Jacket j b -> t
forall i a b t j. Bazaar (Indexed i) a b t -> Jacket j b -> t
jacketOuts Bazaar (Indexed i) a b t
bz (Jacket j b -> t) -> f (Jacket j b) -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Jacket i a -> f (Jacket j b)
f (Bazaar (Indexed i) a b t -> Jacket i a
forall i a b t. Bazaar (Indexed i) a b t -> Jacket i a
jacketIns Bazaar (Indexed i) a b t
bz) where
bz :: Bazaar (Indexed i) a b t
bz = AnIndexedTraversal i s t a b
l Indexed i a (Bazaar (Indexed i) a b b)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s
{-# INLINE jacket #-}
data Path i a
= ApL Int Bool Bool (Last i) !(Path i a) !(Jacket i a)
| ApR Int Bool Bool (Last i) !(Jacket i a) !(Path i a)
| Start
deriving Int -> Path i a -> ShowS
[Path i a] -> ShowS
Path i a -> String
(Int -> Path i a -> ShowS)
-> (Path i a -> String) -> ([Path i a] -> ShowS) -> Show (Path i a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall i a. (Show i, Show a) => Int -> Path i a -> ShowS
forall i a. (Show i, Show a) => [Path i a] -> ShowS
forall i a. (Show i, Show a) => Path i a -> String
showList :: [Path i a] -> ShowS
$cshowList :: forall i a. (Show i, Show a) => [Path i a] -> ShowS
show :: Path i a -> String
$cshow :: forall i a. (Show i, Show a) => Path i a -> String
showsPrec :: Int -> Path i a -> ShowS
$cshowsPrec :: forall i a. (Show i, Show a) => Int -> Path i a -> ShowS
Show
instance Functor (Path i) where
fmap :: (a -> b) -> Path i a -> Path i b
fmap a -> b
f (ApL Int
m Bool
nl Bool
nr Last i
li Path i a
p Jacket i a
q) = Int -> Bool -> Bool -> Last i -> Path i b -> Jacket i b -> Path i b
forall i a.
Int -> Bool -> Bool -> Last i -> Path i a -> Jacket i a -> Path i a
ApL Int
m Bool
nl Bool
nr Last i
li ((a -> b) -> Path i a -> Path i b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Path i a
p) ((a -> b) -> Jacket i a -> Jacket i b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Jacket i a
q)
fmap a -> b
f (ApR Int
m Bool
nl Bool
nr Last i
li Jacket i a
p Path i a
q) = Int -> Bool -> Bool -> Last i -> Jacket i b -> Path i b -> Path i b
forall i a.
Int -> Bool -> Bool -> Last i -> Jacket i a -> Path i a -> Path i a
ApR Int
m Bool
nl Bool
nr Last i
li ((a -> b) -> Jacket i a -> Jacket i b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Jacket i a
p) ((a -> b) -> Path i a -> Path i b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Path i a
q)
fmap a -> b
_ Path i a
Start = Path i b
forall i a. Path i a
Start
{-# INLINE fmap #-}
offset :: Path i a -> Int
offset :: Path i a -> Int
offset Path i a
Start = Int
0
offset (ApL Int
_ Bool
_ Bool
_ Last i
_ Path i a
q Jacket i a
_) = Path i a -> Int
forall i a. Path i a -> Int
offset Path i a
q
offset (ApR Int
_ Bool
_ Bool
_ Last i
_ Jacket i a
l Path i a
q) = Jacket i a -> Int
forall i a. Jacket i a -> Int
size Jacket i a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Path i a -> Int
forall i a. Path i a -> Int
offset Path i a
q
{-# INLINE offset #-}
pathsize :: Path i a -> Int
pathsize :: Path i a -> Int
pathsize = Int -> Path i a -> Int
forall i a. Int -> Path i a -> Int
go Int
1 where
go :: Int -> Path i a -> Int
go Int
n Path i a
Start = Int
n
go Int
_ (ApL Int
n Bool
_ Bool
_ Last i
_ Path i a
p Jacket i a
_) = Int -> Path i a -> Int
go Int
n Path i a
p
go Int
_ (ApR Int
n Bool
_ Bool
_ Last i
_ Jacket i a
_ Path i a
p) = Int -> Path i a -> Int
go Int
n Path i a
p
{-# INLINE pathsize #-}
recompress :: Path i a -> i -> a -> Jacket i a
recompress :: Path i a -> i -> a -> Jacket i a
recompress Path i a
Start i
i a
a = i -> a -> Jacket i a
forall i a. i -> a -> Jacket i a
Leaf i
i a
a
recompress (ApL Int
m Bool
_ Bool
_ Last i
li Path i a
Start Jacket i a
r) i
i a
a = Int
-> Bool -> Bool -> Last i -> Jacket i a -> Jacket i a -> Jacket i a
forall i a.
Int
-> Bool -> Bool -> Last i -> Jacket i a -> Jacket i a -> Jacket i a
Ap Int
m Bool
False Bool
False Last i
li (i -> a -> Jacket i a
forall i a. i -> a -> Jacket i a
Leaf i
i a
a) Jacket i a
r
recompress Path i a
p i
i a
a = Path i a -> Jacket i a -> Jacket i a
forall i a. Path i a -> Jacket i a -> Jacket i a
go Path i a
p (i -> a -> Jacket i a
forall i a. i -> a -> Jacket i a
Leaf i
i a
a) where
go :: Path i a -> Jacket i a -> Jacket i a
go Path i a
Start Jacket i a
q = Jacket i a
q
go (ApL Int
m Bool
_ Bool
_ Last i
li Path i a
q Jacket i a
r) Jacket i a
l = Path i a -> Jacket i a -> Jacket i a
go Path i a
q (Int
-> Bool -> Bool -> Last i -> Jacket i a -> Jacket i a -> Jacket i a
forall i a.
Int
-> Bool -> Bool -> Last i -> Jacket i a -> Jacket i a -> Jacket i a
Ap Int
m Bool
False Bool
False Last i
li Jacket i a
l Jacket i a
r)
go (ApR Int
m Bool
_ Bool
_ Last i
li Jacket i a
l Path i a
q) Jacket i a
r = Path i a -> Jacket i a -> Jacket i a
go Path i a
q (Int
-> Bool -> Bool -> Last i -> Jacket i a -> Jacket i a -> Jacket i a
forall i a.
Int
-> Bool -> Bool -> Last i -> Jacket i a -> Jacket i a -> Jacket i a
Ap Int
m Bool
False Bool
False Last i
li Jacket i a
l Jacket i a
r)
{-# INLINE recompress #-}
startl :: Path i a -> Jacket i a -> r -> (Path i a -> i -> a -> r) -> r
startl :: Path i a -> Jacket i a -> r -> (Path i a -> i -> a -> r) -> r
startl Path i a
p0 (Leaf i
i a
a) r
_ Path i a -> i -> a -> r
kp = Path i a -> i -> a -> r
kp Path i a
p0 i
i a
a
startl Path i a
p0 (Ap Int
m Bool
nl Bool
nr Last i
li (Leaf i
i a
a) Jacket i a
r) r
_ Path i a -> i -> a -> r
kp = Path i a -> i -> a -> r
kp (Int -> Bool -> Bool -> Last i -> Path i a -> Jacket i a -> Path i a
forall i a.
Int -> Bool -> Bool -> Last i -> Path i a -> Jacket i a -> Path i a
ApL Int
m Bool
nl Bool
nr Last i
li Path i a
p0 Jacket i a
r) i
i a
a
startl Path i a
p0 Jacket i a
c0 r
kn Path i a -> i -> a -> r
kp = Path i a -> Jacket i a -> r
go Path i a
p0 Jacket i a
c0 where
go :: Path i a -> Jacket i a -> r
go Path i a
p (Ap Int
m Bool
nl Bool
nr Last i
li Jacket i a
l Jacket i a
r)
| Jacket i a -> Bool
forall i a. Jacket i a -> Bool
nullLeft Jacket i a
l = Path i a -> Jacket i a -> r
go (Int -> Bool -> Bool -> Last i -> Jacket i a -> Path i a -> Path i a
forall i a.
Int -> Bool -> Bool -> Last i -> Jacket i a -> Path i a -> Path i a
ApR Int
m Bool
nl Bool
nr Last i
li Jacket i a
forall i a. Jacket i a
Pure Path i a
p) Jacket i a
r
| Bool
otherwise = Path i a -> Jacket i a -> r
go (Int -> Bool -> Bool -> Last i -> Path i a -> Jacket i a -> Path i a
forall i a.
Int -> Bool -> Bool -> Last i -> Path i a -> Jacket i a -> Path i a
ApL Int
m Bool
nl Bool
nr Last i
li Path i a
p Jacket i a
r) Jacket i a
l
go Path i a
p (Leaf i
i a
a) = Path i a -> i -> a -> r
kp Path i a
p i
i a
a
go Path i a
_ Jacket i a
Pure = r
kn
{-# INLINE startl #-}
startr :: Path i a -> Jacket i a -> r -> (Path i a -> i -> a -> r) -> r
startr :: Path i a -> Jacket i a -> r -> (Path i a -> i -> a -> r) -> r
startr Path i a
p0 (Leaf i
i a
a) r
_ Path i a -> i -> a -> r
kp = Path i a -> i -> a -> r
kp Path i a
p0 i
i a
a
startr Path i a
p0 Jacket i a
c0 r
kn Path i a -> i -> a -> r
kp = Path i a -> Jacket i a -> r
go Path i a
p0 Jacket i a
c0 where
go :: Path i a -> Jacket i a -> r
go Path i a
p (Ap Int
m Bool
nl Bool
nr Last i
li Jacket i a
l Jacket i a
r)
| Jacket i a -> Bool
forall i a. Jacket i a -> Bool
nullRight Jacket i a
r = Path i a -> Jacket i a -> r
go (Int -> Bool -> Bool -> Last i -> Path i a -> Jacket i a -> Path i a
forall i a.
Int -> Bool -> Bool -> Last i -> Path i a -> Jacket i a -> Path i a
ApL Int
m Bool
nl Bool
nr Last i
li Path i a
p Jacket i a
forall i a. Jacket i a
Pure) Jacket i a
l
| Bool
otherwise = Path i a -> Jacket i a -> r
go (Int -> Bool -> Bool -> Last i -> Jacket i a -> Path i a -> Path i a
forall i a.
Int -> Bool -> Bool -> Last i -> Jacket i a -> Path i a -> Path i a
ApR Int
m Bool
nl Bool
nr Last i
li Jacket i a
l Path i a
p) Jacket i a
r
go Path i a
p (Leaf i
i a
a) = Path i a -> i -> a -> r
kp Path i a
p i
i a
a
go Path i a
_ Jacket i a
Pure = r
kn
{-# INLINE startr #-}
movel :: Path i a -> Jacket i a -> r -> (Path i a -> i -> a -> r) -> r
movel :: Path i a -> Jacket i a -> r -> (Path i a -> i -> a -> r) -> r
movel Path i a
p0 Jacket i a
c0 r
kn Path i a -> i -> a -> r
kp = Path i a -> Jacket i a -> r
go Path i a
p0 Jacket i a
c0 where
go :: Path i a -> Jacket i a -> r
go Path i a
Start Jacket i a
_ = r
kn
go (ApR Int
m Bool
_ Bool
_ Last i
li Jacket i a
l Path i a
q) Jacket i a
r
| Jacket i a -> Bool
forall i a. Jacket i a -> Bool
nullRight Jacket i a
l = Path i a -> Jacket i a -> r
go Path i a
q (Int
-> Bool -> Bool -> Last i -> Jacket i a -> Jacket i a -> Jacket i a
forall i a.
Int
-> Bool -> Bool -> Last i -> Jacket i a -> Jacket i a -> Jacket i a
Ap Int
m Bool
False Bool
False Last i
li Jacket i a
forall i a. Jacket i a
Pure Jacket i a
r)
| Bool
otherwise = Path i a -> Jacket i a -> r -> (Path i a -> i -> a -> r) -> r
forall i a r.
Path i a -> Jacket i a -> r -> (Path i a -> i -> a -> r) -> r
startr (Int -> Bool -> Bool -> Last i -> Path i a -> Jacket i a -> Path i a
forall i a.
Int -> Bool -> Bool -> Last i -> Path i a -> Jacket i a -> Path i a
ApL Int
m Bool
False Bool
False Last i
li Path i a
q Jacket i a
r) Jacket i a
l r
kn Path i a -> i -> a -> r
kp
go (ApL Int
m Bool
_ Bool
_ Last i
li Path i a
p Jacket i a
r) Jacket i a
l = Path i a -> Jacket i a -> r
go Path i a
p (Int
-> Bool -> Bool -> Last i -> Jacket i a -> Jacket i a -> Jacket i a
forall i a.
Int
-> Bool -> Bool -> Last i -> Jacket i a -> Jacket i a -> Jacket i a
Ap Int
m Bool
False Bool
False Last i
li Jacket i a
l Jacket i a
r)
{-# INLINE movel #-}
mover :: Path i a -> Jacket i a -> r -> (Path i a -> i -> a -> r) -> r
mover :: Path i a -> Jacket i a -> r -> (Path i a -> i -> a -> r) -> r
mover Path i a
p0 Jacket i a
c0 r
kn Path i a -> i -> a -> r
kp = Path i a -> Jacket i a -> r
go Path i a
p0 Jacket i a
c0 where
go :: Path i a -> Jacket i a -> r
go Path i a
Start Jacket i a
_ = r
kn
go (ApL Int
m Bool
_ Bool
_ Last i
li Path i a
q Jacket i a
r) Jacket i a
l
| Jacket i a -> Bool
forall i a. Jacket i a -> Bool
nullLeft Jacket i a
r = Path i a -> Jacket i a -> r
go Path i a
q (Int
-> Bool -> Bool -> Last i -> Jacket i a -> Jacket i a -> Jacket i a
forall i a.
Int
-> Bool -> Bool -> Last i -> Jacket i a -> Jacket i a -> Jacket i a
Ap Int
m Bool
False Bool
False Last i
li Jacket i a
l Jacket i a
forall i a. Jacket i a
Pure)
| Bool
otherwise = Path i a -> Jacket i a -> r -> (Path i a -> i -> a -> r) -> r
forall i a r.
Path i a -> Jacket i a -> r -> (Path i a -> i -> a -> r) -> r
startl (Int -> Bool -> Bool -> Last i -> Jacket i a -> Path i a -> Path i a
forall i a.
Int -> Bool -> Bool -> Last i -> Jacket i a -> Path i a -> Path i a
ApR Int
m Bool
False Bool
False Last i
li Jacket i a
l Path i a
q) Jacket i a
r r
kn Path i a -> i -> a -> r
kp
go (ApR Int
m Bool
_ Bool
_ Last i
li Jacket i a
l Path i a
p) Jacket i a
r = Path i a -> Jacket i a -> r
go Path i a
p (Int
-> Bool -> Bool -> Last i -> Jacket i a -> Jacket i a -> Jacket i a
forall i a.
Int
-> Bool -> Bool -> Last i -> Jacket i a -> Jacket i a -> Jacket i a
Ap Int
m Bool
False Bool
False Last i
li Jacket i a
l Jacket i a
r)
{-# INLINE mover #-}
data Top
data Zipper h i a = Ord i => Zipper !(Coil h i a) Int !Int !(Path i a) i a
infixr 9 :@
data (:@) a i
infixl 8 :>
type family (:>) h p
type instance h :> (a :@ i) = Zipper h i a
infixl 8 :>>
type h :>> a = Zipper h Int a
type family Zipped h a
type instance Zipped Top a = a
type instance Zipped (Zipper h i a) s = Zipped h a
#ifndef HLINT
data Coil t i a where
Coil :: Coil Top Int a
Snoc :: Ord i => !(Coil h j s) -> AnIndexedTraversal' i s a -> Int -> !Int -> !(Path j s) -> j -> (Jacket i a -> s) -> Coil (Zipper h j s) i a
#endif
focus :: IndexedLens' i (Zipper h i a) a
focus :: p a (f a) -> Zipper h i a -> f (Zipper h i a)
focus p a (f a)
f (Zipper Coil h i a
h Int
t Int
o Path i a
p i
i a
a) = Coil h i a -> Int -> Int -> Path i a -> i -> a -> Zipper h i a
forall h i a.
Ord i =>
Coil h i a -> Int -> Int -> Path i a -> i -> a -> Zipper h i a
Zipper Coil h i a
h Int
t Int
o Path i a
p i
i (a -> Zipper h i a) -> f a -> f (Zipper h i a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p a (f a) -> i -> a -> f a
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p a (f a)
f i
i a
a
{-# INLINE focus #-}
zipper :: a -> Top :>> a
zipper :: a -> Top :>> a
zipper = Coil Top Int a -> Int -> Int -> Path Int a -> Int -> a -> Top :>> a
forall h i a.
Ord i =>
Coil h i a -> Int -> Int -> Path i a -> i -> a -> Zipper h i a
Zipper Coil Top Int a
forall a. Coil Top Int a
Coil Int
0 Int
0 Path Int a
forall i a. Path i a
Start Int
0
{-# INLINE zipper #-}
focalPoint :: Zipper h i a -> i
focalPoint :: Zipper h i a -> i
focalPoint (Zipper Coil h i a
_ Int
_ Int
_ Path i a
_ i
i a
_) = i
i
{-# INLINE focalPoint #-}
tooth :: Zipper h i a -> Int
tooth :: Zipper h i a -> Int
tooth (Zipper Coil h i a
_ Int
t Int
o Path i a
_ i
_ a
_) = Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o
{-# INLINE tooth #-}
upward :: Ord j => h :> s:@j :> a:@i -> h :> s:@j
upward :: ((h :> (s :@ j)) :> (a :@ i)) -> h :> (s :@ j)
upward (Zipper (Snoc h _ t o p j k) _ _ q i x) = Coil h j s -> Int -> Int -> Path j s -> j -> s -> Zipper h j s
forall h i a.
Ord i =>
Coil h i a -> Int -> Int -> Path i a -> i -> a -> Zipper h i a
Zipper Coil h j s
h Int
t Int
o Path j s
p j
j (s -> Zipper h j s) -> s -> Zipper h j s
forall a b. (a -> b) -> a -> b
$ Jacket i a -> s
k (Jacket i a -> s) -> Jacket i a -> s
forall a b. (a -> b) -> a -> b
$ Path i a -> i -> a -> Jacket i a
forall i a. Path i a -> i -> a -> Jacket i a
recompress Path i a
q i
i a
x
{-# INLINE upward #-}
rightward :: MonadPlus m => h :> a:@i -> m (h :> a:@i)
rightward :: (h :> (a :@ i)) -> m (h :> (a :@ i))
rightward (Zipper h t o p i a) = Path i a
-> Jacket i a
-> m (Zipper h i a)
-> (Path i a -> i -> a -> m (Zipper h i a))
-> m (Zipper h i a)
forall i a r.
Path i a -> Jacket i a -> r -> (Path i a -> i -> a -> r) -> r
mover Path i a
p (i -> a -> Jacket i a
forall i a. i -> a -> Jacket i a
Leaf i
i a
a) m (Zipper h i a)
forall (m :: * -> *) a. MonadPlus m => m a
mzero ((Path i a -> i -> a -> m (Zipper h i a)) -> m (Zipper h i a))
-> (Path i a -> i -> a -> m (Zipper h i a)) -> m (Zipper h i a)
forall a b. (a -> b) -> a -> b
$ \Path i a
q i
j a
b -> Zipper h i a -> m (Zipper h i a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Zipper h i a -> m (Zipper h i a))
-> Zipper h i a -> m (Zipper h i a)
forall a b. (a -> b) -> a -> b
$ Coil h i a -> Int -> Int -> Path i a -> i -> a -> Zipper h i a
forall h i a.
Ord i =>
Coil h i a -> Int -> Int -> Path i a -> i -> a -> Zipper h i a
Zipper Coil h i a
h Int
t (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Path i a
q i
j a
b
{-# INLINE rightward #-}
leftward :: MonadPlus m => h :> a:@i -> m (h :> a:@i)
leftward :: (h :> (a :@ i)) -> m (h :> (a :@ i))
leftward (Zipper h t o p i a) = Path i a
-> Jacket i a
-> m (Zipper h i a)
-> (Path i a -> i -> a -> m (Zipper h i a))
-> m (Zipper h i a)
forall i a r.
Path i a -> Jacket i a -> r -> (Path i a -> i -> a -> r) -> r
movel Path i a
p (i -> a -> Jacket i a
forall i a. i -> a -> Jacket i a
Leaf i
i a
a) m (Zipper h i a)
forall (m :: * -> *) a. MonadPlus m => m a
mzero ((Path i a -> i -> a -> m (Zipper h i a)) -> m (Zipper h i a))
-> (Path i a -> i -> a -> m (Zipper h i a)) -> m (Zipper h i a)
forall a b. (a -> b) -> a -> b
$ \Path i a
q i
j a
b -> Zipper h i a -> m (Zipper h i a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Zipper h i a -> m (Zipper h i a))
-> Zipper h i a -> m (Zipper h i a)
forall a b. (a -> b) -> a -> b
$ Coil h i a -> Int -> Int -> Path i a -> i -> a -> Zipper h i a
forall h i a.
Ord i =>
Coil h i a -> Int -> Int -> Path i a -> i -> a -> Zipper h i a
Zipper Coil h i a
h Int
t (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Path i a
q i
j a
b
{-# INLINE leftward #-}
leftmost :: a :> b:@i -> a :> b:@i
leftmost :: (a :> (b :@ i)) -> a :> (b :@ i)
leftmost (Zipper h _ _ p i a) = Path i b
-> Jacket i b
-> Zipper a i b
-> (Path i b -> i -> b -> Zipper a i b)
-> Zipper a i b
forall i a r.
Path i a -> Jacket i a -> r -> (Path i a -> i -> a -> r) -> r
startl Path i b
forall i a. Path i a
Start (Path i b -> i -> b -> Jacket i b
forall i a. Path i a -> i -> a -> Jacket i a
recompress Path i b
p i
i b
a) (String -> Zipper a i b
forall a. HasCallStack => String -> a
error String
"leftmost: bad Jacket structure") (Coil a i b -> Int -> Int -> Path i b -> i -> b -> Zipper a i b
forall h i a.
Ord i =>
Coil h i a -> Int -> Int -> Path i a -> i -> a -> Zipper h i a
Zipper Coil a i b
h Int
0 Int
0)
{-# INLINE leftmost #-}
rightmost :: a :> b:@i -> a :> b:@i
rightmost :: (a :> (b :@ i)) -> a :> (b :@ i)
rightmost (Zipper h _ _ p i a) = Path i b
-> Jacket i b
-> Zipper a i b
-> (Path i b -> i -> b -> Zipper a i b)
-> Zipper a i b
forall i a r.
Path i a -> Jacket i a -> r -> (Path i a -> i -> a -> r) -> r
startr Path i b
forall i a. Path i a
Start (Path i b -> i -> b -> Jacket i b
forall i a. Path i a -> i -> a -> Jacket i a
recompress Path i b
p i
i b
a) (String -> Zipper a i b
forall a. HasCallStack => String -> a
error String
"rightmost: bad Jacket structure") (\Path i b
q -> Coil a i b -> Int -> Int -> Path i b -> i -> b -> Zipper a i b
forall h i a.
Ord i =>
Coil h i a -> Int -> Int -> Path i a -> i -> a -> Zipper h i a
Zipper Coil a i b
h (Path i b -> Int
forall i a. Path i a -> Int
offset Path i b
q) Int
0 Path i b
q)
{-# INLINE rightmost #-}
tug :: (a -> Maybe a) -> a -> a
tug :: (a -> Maybe a) -> a -> a
tug a -> Maybe a
f a
a = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
a (a -> Maybe a
f a
a)
{-# INLINE tug #-}
tugs :: (a -> Maybe a) -> Int -> a -> a
tugs :: (a -> Maybe a) -> Int -> a -> a
tugs a -> Maybe a
f Int
n0
| Int
n0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> a -> a
forall a. HasCallStack => String -> a
error String
"tugs: negative tug count"
| Bool
otherwise = Int -> a -> a
go Int
n0
where
go :: Int -> a -> a
go Int
0 a
a = a
a
go Int
n a
a = a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
a (Int -> a -> a
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (a -> Maybe a
f a
a)
{-# INLINE tugs #-}
farthest :: (a -> Maybe a) -> a -> a
farthest :: (a -> Maybe a) -> a -> a
farthest a -> Maybe a
f = a -> a
go where
go :: a -> a
go a
a = a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
a a -> a
go (a -> Maybe a
f a
a)
{-# INLINE farthest #-}
jerks :: Fail.MonadFail m => (a -> m a) -> Int -> a -> m a
jerks :: (a -> m a) -> Int -> a -> m a
jerks a -> m a
f Int
n0
| Int
n0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = \a
_ -> String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"jerks: negative jerk count"
| Bool
otherwise = Int -> a -> m a
go Int
n0
where
go :: Int -> a -> m a
go Int
0 a
a = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
go Int
n a
a = a -> m a
f a
a m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> a -> m a
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
{-# INLINE jerks #-}
jerksError :: Monad m => (a -> m a) -> Int -> a -> m a
jerksError :: (a -> m a) -> Int -> a -> m a
jerksError a -> m a
f Int
n0
| Int
n0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = \a
_ -> String -> m a
forall a. HasCallStack => String -> a
error String
"jerksError: negative jerk count"
| Bool
otherwise = Int -> a -> m a
go Int
n0
where
go :: Int -> a -> m a
go Int
0 a
a = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
go Int
n a
a = a -> m a
f a
a m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> a -> m a
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
{-# INLINE jerksError #-}
teeth :: h :> a:@i -> Int
teeth :: (h :> (a :@ i)) -> Int
teeth (Zipper _ _ _ p _ _) = Path i a -> Int
forall i a. Path i a -> Int
pathsize Path i a
p
{-# INLINE teeth #-}
jerkTo :: MonadPlus m => Int -> (h :> a:@i) -> m (h :> a:@i)
jerkTo :: Int -> (h :> (a :@ i)) -> m (h :> (a :@ i))
jerkTo Int
n h :> (a :@ i)
z = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
k Int
n of
Ordering
LT -> (Zipper h i a -> m (Zipper h i a))
-> Int -> Zipper h i a -> m (Zipper h i a)
forall (m :: * -> *) a. Monad m => (a -> m a) -> Int -> a -> m a
jerksError Zipper h i a -> m (Zipper h i a)
forall (m :: * -> *) h a i.
MonadPlus m =>
(h :> (a :@ i)) -> m (h :> (a :@ i))
rightward (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) h :> (a :@ i)
Zipper h i a
z
Ordering
EQ -> Zipper h i a -> m (Zipper h i a)
forall (m :: * -> *) a. Monad m => a -> m a
return h :> (a :@ i)
Zipper h i a
z
Ordering
GT -> (Zipper h i a -> m (Zipper h i a))
-> Int -> Zipper h i a -> m (Zipper h i a)
forall (m :: * -> *) a. Monad m => (a -> m a) -> Int -> a -> m a
jerksError Zipper h i a -> m (Zipper h i a)
forall (m :: * -> *) h a i.
MonadPlus m =>
(h :> (a :@ i)) -> m (h :> (a :@ i))
leftward (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) h :> (a :@ i)
Zipper h i a
z
where k :: Int
k = Zipper h i a -> Int
forall h i a. Zipper h i a -> Int
tooth h :> (a :@ i)
Zipper h i a
z
{-# INLINE jerkTo #-}
tugTo :: Int -> h :> a:@i -> h :> a:@i
tugTo :: Int -> (h :> (a :@ i)) -> h :> (a :@ i)
tugTo Int
n h :> (a :@ i)
z = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
k Int
n of
Ordering
LT -> (Zipper h i a -> Maybe (Zipper h i a))
-> Int -> Zipper h i a -> Zipper h i a
forall a. (a -> Maybe a) -> Int -> a -> a
tugs Zipper h i a -> Maybe (Zipper h i a)
forall (m :: * -> *) h a i.
MonadPlus m =>
(h :> (a :@ i)) -> m (h :> (a :@ i))
rightward (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) h :> (a :@ i)
Zipper h i a
z
Ordering
EQ -> h :> (a :@ i)
z
Ordering
GT -> (Zipper h i a -> Maybe (Zipper h i a))
-> Int -> Zipper h i a -> Zipper h i a
forall a. (a -> Maybe a) -> Int -> a -> a
tugs Zipper h i a -> Maybe (Zipper h i a)
forall (m :: * -> *) h a i.
MonadPlus m =>
(h :> (a :@ i)) -> m (h :> (a :@ i))
leftward (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) h :> (a :@ i)
Zipper h i a
z
where k :: Int
k = Zipper h i a -> Int
forall h i a. Zipper h i a -> Int
tooth h :> (a :@ i)
Zipper h i a
z
{-# INLINE tugTo #-}
moveToward :: i -> h :> a:@i -> h :> a:@i
moveToward :: i -> (h :> (a :@ i)) -> h :> (a :@ i)
moveToward i
i z :: h :> (a :@ i)
z@(Zipper h _ _ p0 j s0)
| i
i i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
j = h :> (a :@ i)
z
| Bool
otherwise = Path i a -> Jacket i a -> Zipper h i a
go Path i a
forall i a. Path i a
Start (Path i a -> i -> a -> Jacket i a
forall i a. Path i a -> i -> a -> Jacket i a
recompress Path i a
p0 i
j a
s0)
where
go :: Path i a -> Jacket i a -> Zipper h i a
go Path i a
_ Jacket i a
Pure = h :> (a :@ i)
Zipper h i a
z
go Path i a
p (Ap Int
m Bool
nl Bool
nr Last i
li Jacket i a
l Jacket i a
r)
| Last (Just i
k) <- Jacket i a -> Last i
forall i a. Jacket i a -> Last i
maximal Jacket i a
l, i
k i -> i -> Bool
forall a. Ord a => a -> a -> Bool
>= i
i = Path i a -> Jacket i a -> Zipper h i a
go (Int -> Bool -> Bool -> Last i -> Path i a -> Jacket i a -> Path i a
forall i a.
Int -> Bool -> Bool -> Last i -> Path i a -> Jacket i a -> Path i a
ApL Int
m Bool
nl Bool
nr Last i
li Path i a
p Jacket i a
r) Jacket i a
l
| Bool
otherwise = Path i a -> Jacket i a -> Zipper h i a
go (Int -> Bool -> Bool -> Last i -> Jacket i a -> Path i a -> Path i a
forall i a.
Int -> Bool -> Bool -> Last i -> Jacket i a -> Path i a -> Path i a
ApR Int
m Bool
nl Bool
nr Last i
li Jacket i a
l Path i a
p) Jacket i a
r
go Path i a
p (Leaf i
k a
a) = Coil h i a -> Int -> Int -> Path i a -> i -> a -> Zipper h i a
forall h i a.
Ord i =>
Coil h i a -> Int -> Int -> Path i a -> i -> a -> Zipper h i a
Zipper Coil h i a
h (Path i a -> Int
forall i a. Path i a -> Int
offset Path i a
p) Int
0 Path i a
p i
k a
a
{-# INLINE moveToward #-}
moveTo :: MonadPlus m => i -> h :> a:@i -> m (h :> a:@i)
moveTo :: i -> (h :> (a :@ i)) -> m (h :> (a :@ i))
moveTo i
i h :> (a :@ i)
z = case i -> (h :> (a :@ i)) -> h :> (a :@ i)
forall i h a. i -> (h :> (a :@ i)) -> h :> (a :@ i)
moveToward i
i h :> (a :@ i)
z of
z' :: h :> (a :@ i)
z'@(Zipper _ _ _ _ j _)
| i
i i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
j -> Zipper h i a -> m (Zipper h i a)
forall (m :: * -> *) a. Monad m => a -> m a
return h :> (a :@ i)
Zipper h i a
z'
| Bool
otherwise -> m (h :> (a :@ i))
forall (m :: * -> *) a. MonadPlus m => m a
mzero
{-# INLINE moveTo #-}
lensed :: ALens' s a -> IndexedLens' Int s a
lensed :: ALens' s a -> IndexedLens' Int s a
lensed ALens' s a
l p a (f a)
f = ALens' s a -> (a -> f a) -> s -> f s
forall s t a b. ALens s t a b -> Lens s t a b
cloneLens ALens' s a
l (p a (f a) -> Int -> a -> f a
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p a (f a)
f (Int
0 :: Int))
{-# INLINE lensed #-}
downward :: forall j h s a. ALens' s a -> h :> s:@j -> h :> s:@j :>> a
downward :: ALens' s a -> (h :> (s :@ j)) -> (h :> (s :@ j)) :>> a
downward ALens' s a
l (Zipper h t o p j s) = Coil (Zipper h j s) Int a
-> Int
-> Int
-> Path Int a
-> Int
-> a
-> Zipper (Zipper h j s) Int a
forall h i a.
Ord i =>
Coil h i a -> Int -> Int -> Path i a -> i -> a -> Zipper h i a
Zipper (Coil h j s
-> AnIndexedTraversal' Int s a
-> Int
-> Int
-> Path j s
-> j
-> (Jacket Int a -> s)
-> Coil (Zipper h j s) Int a
forall i h j s a.
Ord i =>
Coil h j s
-> AnIndexedTraversal' i s a
-> Int
-> Int
-> Path j s
-> j
-> (Jacket i a -> s)
-> Coil (Zipper h j s) i a
Snoc Coil h j s
h AnIndexedTraversal' Int s a
IndexedLens' Int s a
l' Int
t Int
o Path j s
p j
j Jacket Int a -> s
go) Int
0 Int
0 Path Int a
forall i a. Path i a
Start Int
0 (s
ss -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^.Getting a s a
IndexedLens' Int s a
l')
where l' :: IndexedLens' Int s a
l' :: p a (f a) -> s -> f s
l' = ALens' s a -> IndexedLens' Int s a
forall s a. ALens' s a -> IndexedLens' Int s a
lensed ALens' s a
l
go :: Jacket Int a -> s
go (Leaf Int
_ a
b) = ASetter s s a a -> a -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s s a a
IndexedLens' Int s a
l' a
b s
s
go Jacket Int a
_ = String -> s
forall a. HasCallStack => String -> a
error String
"downward: rezipping"
{-# INLINE downward #-}
idownward :: forall i j h s a. Ord i => AnIndexedLens' i s a -> h :> s:@j -> h :> s:@j :> a:@i
idownward :: AnIndexedLens' i s a
-> (h :> (s :@ j)) -> (h :> (s :@ j)) :> (a :@ i)
idownward AnIndexedLens' i s a
l (Zipper h t o p j s) = Coil (Zipper h j s) i a
-> Int -> Int -> Path i a -> i -> a -> Zipper (Zipper h j s) i a
forall h i a.
Ord i =>
Coil h i a -> Int -> Int -> Path i a -> i -> a -> Zipper h i a
Zipper (Coil h j s
-> AnIndexedTraversal' i s a
-> Int
-> Int
-> Path j s
-> j
-> (Jacket i a -> s)
-> Coil (Zipper h j s) i a
forall i h j s a.
Ord i =>
Coil h j s
-> AnIndexedTraversal' i s a
-> Int
-> Int
-> Path j s
-> j
-> (Jacket i a -> s)
-> Coil (Zipper h j s) i a
Snoc Coil h j s
h AnIndexedTraversal' i s a
IndexedLens' i s a
l' Int
t Int
o Path j s
p j
j Jacket i a -> s
go) Int
0 Int
0 Path i a
forall i a. Path i a
Start i
i a
a
where l' :: IndexedLens' i s a
l' :: p a (f a) -> s -> f s
l' = AnIndexedLens' i s a -> IndexedLens' i s a
forall i s t a b. AnIndexedLens i s t a b -> IndexedLens i s t a b
cloneIndexedLens AnIndexedLens' i s a
l
(i
i, a
a) = IndexedGetting i (i, a) s a -> s -> (i, a)
forall s (m :: * -> *) i a.
MonadReader s m =>
IndexedGetting i (i, a) s a -> m (i, a)
iview IndexedGetting i (i, a) s a
IndexedLens' i s a
l' s
s
go :: Jacket i a -> s
go (Leaf i
_ a
b) = ASetter s s a a -> a -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s s a a
IndexedLens' i s a
l' a
b s
s
go Jacket i a
_ = String -> s
forall a. HasCallStack => String -> a
error String
"idownward: rezipping"
{-# INLINE idownward #-}
within :: MonadPlus m => LensLike' (Indexing (Bazaar' (Indexed Int) a)) s a -> (h :> s:@j) -> m (h :> s:@j :>> a)
within :: LensLike' (Indexing (Bazaar' (Indexed Int) a)) s a
-> (h :> (s :@ j)) -> m ((h :> (s :@ j)) :>> a)
within = AnIndexedTraversal' Int s a
-> Zipper h j s -> m (Zipper (Zipper h j s) Int a)
forall (m :: * -> *) i s a h j.
(MonadPlus m, Ord i) =>
AnIndexedTraversal' i s a
-> (h :> (s :@ j)) -> m ((h :> (s :@ j)) :> (a :@ i))
iwithin (AnIndexedTraversal' Int s a
-> Zipper h j s -> m (Zipper (Zipper h j s) Int a))
-> (LensLike' (Indexing (Bazaar' (Indexed Int) a)) s a
-> AnIndexedTraversal' Int s a)
-> LensLike' (Indexing (Bazaar' (Indexed Int) a)) s a
-> Zipper h j s
-> m (Zipper (Zipper h j s) Int a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike' (Indexing (Bazaar' (Indexed Int) a)) s a
-> AnIndexedTraversal' Int s a
forall (p :: * -> * -> *) a (f :: * -> *) b s t.
Indexable Int p =>
((a -> Indexing f b) -> s -> Indexing f t) -> p a (f b) -> s -> f t
indexing
{-# INLINE within #-}
iwithin :: (MonadPlus m, Ord i) => AnIndexedTraversal' i s a -> (h :> s:@j) -> m (h :> s:@j :> a:@i)
iwithin :: AnIndexedTraversal' i s a
-> (h :> (s :@ j)) -> m ((h :> (s :@ j)) :> (a :@ i))
iwithin AnIndexedTraversal' i s a
l (Zipper h t o p j s) = case AnIndexedTraversal' i s a
-> (Jacket i a -> Context (Jacket i a) (Jacket i a) (Jacket i a))
-> s
-> Context (Jacket i a) (Jacket i a) s
forall i s t a b j.
AnIndexedTraversal i s t a b -> Lens s t (Jacket i a) (Jacket j b)
jacket AnIndexedTraversal' i s a
l ((Jacket i a -> Jacket i a)
-> Jacket i a -> Context (Jacket i a) (Jacket i a) (Jacket i a)
forall a b t. (b -> t) -> a -> Context a b t
Context Jacket i a -> Jacket i a
forall a. a -> a
id) s
s of
Context Jacket i a -> s
k Jacket i a
xs -> Path i a
-> Jacket i a
-> m (Zipper (Zipper h j s) i a)
-> (Path i a -> i -> a -> m (Zipper (Zipper h j s) i a))
-> m (Zipper (Zipper h j s) i a)
forall i a r.
Path i a -> Jacket i a -> r -> (Path i a -> i -> a -> r) -> r
startl Path i a
forall i a. Path i a
Start Jacket i a
xs m (Zipper (Zipper h j s) i a)
forall (m :: * -> *) a. MonadPlus m => m a
mzero ((Path i a -> i -> a -> m (Zipper (Zipper h j s) i a))
-> m (Zipper (Zipper h j s) i a))
-> (Path i a -> i -> a -> m (Zipper (Zipper h j s) i a))
-> m (Zipper (Zipper h j s) i a)
forall a b. (a -> b) -> a -> b
$ \Path i a
q i
i a
a -> Zipper (Zipper h j s) i a -> m (Zipper (Zipper h j s) i a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Zipper (Zipper h j s) i a -> m (Zipper (Zipper h j s) i a))
-> Zipper (Zipper h j s) i a -> m (Zipper (Zipper h j s) i a)
forall a b. (a -> b) -> a -> b
$ Coil (Zipper h j s) i a
-> Int -> Int -> Path i a -> i -> a -> Zipper (Zipper h j s) i a
forall h i a.
Ord i =>
Coil h i a -> Int -> Int -> Path i a -> i -> a -> Zipper h i a
Zipper (Coil h j s
-> AnIndexedTraversal' i s a
-> Int
-> Int
-> Path j s
-> j
-> (Jacket i a -> s)
-> Coil (Zipper h j s) i a
forall i h j s a.
Ord i =>
Coil h j s
-> AnIndexedTraversal' i s a
-> Int
-> Int
-> Path j s
-> j
-> (Jacket i a -> s)
-> Coil (Zipper h j s) i a
Snoc Coil h j s
h AnIndexedTraversal' i s a
l Int
t Int
o Path j s
p j
j Jacket i a -> s
k) Int
0 Int
0 Path i a
q i
i a
a
{-# INLINE iwithin #-}
withins :: MonadPlus m => LensLike' (Indexing (Bazaar' (Indexed Int) a)) s a -> (h :> s:@j) -> m (h :> s:@j :>> a)
withins :: LensLike' (Indexing (Bazaar' (Indexed Int) a)) s a
-> (h :> (s :@ j)) -> m ((h :> (s :@ j)) :>> a)
withins = AnIndexedTraversal' Int s a
-> Zipper h j s -> m (Zipper (Zipper h j s) Int a)
forall (m :: * -> *) i s a h j.
(MonadPlus m, Ord i) =>
AnIndexedTraversal' i s a
-> (h :> (s :@ j)) -> m ((h :> (s :@ j)) :> (a :@ i))
iwithins (AnIndexedTraversal' Int s a
-> Zipper h j s -> m (Zipper (Zipper h j s) Int a))
-> (LensLike' (Indexing (Bazaar' (Indexed Int) a)) s a
-> AnIndexedTraversal' Int s a)
-> LensLike' (Indexing (Bazaar' (Indexed Int) a)) s a
-> Zipper h j s
-> m (Zipper (Zipper h j s) Int a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike' (Indexing (Bazaar' (Indexed Int) a)) s a
-> AnIndexedTraversal' Int s a
forall (p :: * -> * -> *) a (f :: * -> *) b s t.
Indexable Int p =>
((a -> Indexing f b) -> s -> Indexing f t) -> p a (f b) -> s -> f t
indexing
{-# INLINE withins #-}
iwithins :: (MonadPlus m, Ord i) => AnIndexedTraversal' i s a -> (h :> s:@j) -> m (h :> s:@j :> a:@i)
iwithins :: AnIndexedTraversal' i s a
-> (h :> (s :@ j)) -> m ((h :> (s :@ j)) :> (a :@ i))
iwithins AnIndexedTraversal' i s a
z (Zipper h t o p j s) = case AnIndexedTraversal' i s a
-> (Jacket i a -> Context (Jacket i a) (Jacket i a) (Jacket i a))
-> s
-> Context (Jacket i a) (Jacket i a) s
forall i s t a b j.
AnIndexedTraversal i s t a b -> Lens s t (Jacket i a) (Jacket j b)
jacket AnIndexedTraversal' i s a
z ((Jacket i a -> Jacket i a)
-> Jacket i a -> Context (Jacket i a) (Jacket i a) (Jacket i a)
forall a b t. (b -> t) -> a -> Context a b t
Context Jacket i a -> Jacket i a
forall a. a -> a
id) s
s of
Context Jacket i a -> s
k Jacket i a
xs -> let up :: Coil (Zipper h j s) i a
up = Coil h j s
-> AnIndexedTraversal' i s a
-> Int
-> Int
-> Path j s
-> j
-> (Jacket i a -> s)
-> Coil (Zipper h j s) i a
forall i h j s a.
Ord i =>
Coil h j s
-> AnIndexedTraversal' i s a
-> Int
-> Int
-> Path j s
-> j
-> (Jacket i a -> s)
-> Coil (Zipper h j s) i a
Snoc Coil h j s
h AnIndexedTraversal' i s a
z Int
t Int
o Path j s
p j
j Jacket i a -> s
k
go :: Path i a -> Jacket i a -> m (Zipper (Zipper h j s) i a)
go Path i a
q (Ap Int
m Bool
nl Bool
nr Last i
li Jacket i a
l Jacket i a
r) = Path i a -> Jacket i a -> m (Zipper (Zipper h j s) i a)
go (Int -> Bool -> Bool -> Last i -> Path i a -> Jacket i a -> Path i a
forall i a.
Int -> Bool -> Bool -> Last i -> Path i a -> Jacket i a -> Path i a
ApL Int
m Bool
nl Bool
nr Last i
li Path i a
q Jacket i a
r) Jacket i a
l m (Zipper (Zipper h j s) i a)
-> m (Zipper (Zipper h j s) i a) -> m (Zipper (Zipper h j s) i a)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Path i a -> Jacket i a -> m (Zipper (Zipper h j s) i a)
go (Int -> Bool -> Bool -> Last i -> Jacket i a -> Path i a -> Path i a
forall i a.
Int -> Bool -> Bool -> Last i -> Jacket i a -> Path i a -> Path i a
ApR Int
m Bool
nl Bool
nr Last i
li Jacket i a
l Path i a
q) Jacket i a
r
go Path i a
q (Leaf i
i a
a) = Zipper (Zipper h j s) i a -> m (Zipper (Zipper h j s) i a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Zipper (Zipper h j s) i a -> m (Zipper (Zipper h j s) i a))
-> Zipper (Zipper h j s) i a -> m (Zipper (Zipper h j s) i a)
forall a b. (a -> b) -> a -> b
$ Coil (Zipper h j s) i a
-> Int -> Int -> Path i a -> i -> a -> Zipper (Zipper h j s) i a
forall h i a.
Ord i =>
Coil h i a -> Int -> Int -> Path i a -> i -> a -> Zipper h i a
Zipper Coil (Zipper h j s) i a
up (Path i a -> Int
forall i a. Path i a -> Int
offset Path i a
q) Int
0 Path i a
q i
i a
a
go Path i a
_ Jacket i a
Pure = m (Zipper (Zipper h j s) i a)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
in Path i a -> Jacket i a -> m (Zipper (Zipper h j s) i a)
go Path i a
forall i a. Path i a
Start Jacket i a
xs
{-# INLINE iwithins #-}
fromWithin :: LensLike' (Indexing (Bazaar' (Indexed Int) a)) s a -> (h :> s:@j) -> h :> s:@j :>> a
fromWithin :: LensLike' (Indexing (Bazaar' (Indexed Int) a)) s a
-> (h :> (s :@ j)) -> (h :> (s :@ j)) :>> a
fromWithin = AnIndexedTraversal' Int s a
-> Zipper h j s -> Zipper (Zipper h j s) Int a
forall i s a h j.
Ord i =>
AnIndexedTraversal' i s a
-> (h :> (s :@ j)) -> (h :> (s :@ j)) :> (a :@ i)
ifromWithin (AnIndexedTraversal' Int s a
-> Zipper h j s -> Zipper (Zipper h j s) Int a)
-> (LensLike' (Indexing (Bazaar' (Indexed Int) a)) s a
-> AnIndexedTraversal' Int s a)
-> LensLike' (Indexing (Bazaar' (Indexed Int) a)) s a
-> Zipper h j s
-> Zipper (Zipper h j s) Int a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike' (Indexing (Bazaar' (Indexed Int) a)) s a
-> AnIndexedTraversal' Int s a
forall (p :: * -> * -> *) a (f :: * -> *) b s t.
Indexable Int p =>
((a -> Indexing f b) -> s -> Indexing f t) -> p a (f b) -> s -> f t
indexing
{-# INLINE fromWithin #-}
ifromWithin :: Ord i => AnIndexedTraversal' i s a -> (h :> s:@j) -> h :> s:@j :> a:@i
ifromWithin :: AnIndexedTraversal' i s a
-> (h :> (s :@ j)) -> (h :> (s :@ j)) :> (a :@ i)
ifromWithin AnIndexedTraversal' i s a
l (Zipper h t o p j s) = case AnIndexedTraversal' i s a
-> (Jacket i a -> Context (Jacket i a) (Jacket i a) (Jacket i a))
-> s
-> Context (Jacket i a) (Jacket i a) s
forall i s t a b j.
AnIndexedTraversal i s t a b -> Lens s t (Jacket i a) (Jacket j b)
jacket AnIndexedTraversal' i s a
l ((Jacket i a -> Jacket i a)
-> Jacket i a -> Context (Jacket i a) (Jacket i a) (Jacket i a)
forall a b t. (b -> t) -> a -> Context a b t
Context Jacket i a -> Jacket i a
forall a. a -> a
id) s
s of
Context Jacket i a -> s
k Jacket i a
xs -> let up :: Coil (Zipper h j s) i a
up = Coil h j s
-> AnIndexedTraversal' i s a
-> Int
-> Int
-> Path j s
-> j
-> (Jacket i a -> s)
-> Coil (Zipper h j s) i a
forall i h j s a.
Ord i =>
Coil h j s
-> AnIndexedTraversal' i s a
-> Int
-> Int
-> Path j s
-> j
-> (Jacket i a -> s)
-> Coil (Zipper h j s) i a
Snoc Coil h j s
h AnIndexedTraversal' i s a
l Int
t Int
o Path j s
p j
j Jacket i a -> s
k in
Path i a
-> Jacket i a
-> Zipper (Zipper h j s) i a
-> (Path i a -> i -> a -> Zipper (Zipper h j s) i a)
-> Zipper (Zipper h j s) i a
forall i a r.
Path i a -> Jacket i a -> r -> (Path i a -> i -> a -> r) -> r
startl Path i a
forall i a. Path i a
Start Jacket i a
xs (Coil (Zipper h j s) i a
-> Int -> Int -> Path i a -> i -> a -> Zipper (Zipper h j s) i a
forall h i a.
Ord i =>
Coil h i a -> Int -> Int -> Path i a -> i -> a -> Zipper h i a
Zipper Coil (Zipper h j s) i a
up Int
0 Int
0 Path i a
forall i a. Path i a
Start (String -> i
forall a. HasCallStack => String -> a
error String
"fromWithin an empty Traversal")
(String -> a
forall a. HasCallStack => String -> a
error String
"fromWithin an empty Traversal"))
(Coil (Zipper h j s) i a
-> Int -> Int -> Path i a -> i -> a -> Zipper (Zipper h j s) i a
forall h i a.
Ord i =>
Coil h i a -> Int -> Int -> Path i a -> i -> a -> Zipper h i a
Zipper Coil (Zipper h j s) i a
up Int
0 Int
0)
{-# INLINE ifromWithin #-}
class Zipping h a where
recoil :: Coil h i a -> Jacket i a -> Zipped h a
instance Zipping Top a where
recoil :: Coil Top i a -> Jacket i a -> Zipped Top a
recoil Coil Top i a
Coil (Leaf i
_ a
a) = a
Zipped Top a
a
recoil Coil Top i a
Coil Jacket i a
_ = String -> a
forall a. HasCallStack => String -> a
error String
"recoil: expected Leaf"
{-# INLINE recoil #-}
instance Zipping h s => Zipping (Zipper h i s) a where
recoil :: Coil (Zipper h i s) i a -> Jacket i a -> Zipped (Zipper h i s) a
recoil (Snoc Coil h j s
h AnIndexedTraversal' i s a
_ Int
_ Int
_ Path j s
p j
i Jacket i a -> s
k) Jacket i a
as = Coil h j s -> Jacket j s -> Zipped h s
forall h a i. Zipping h a => Coil h i a -> Jacket i a -> Zipped h a
recoil Coil h j s
h (Jacket j s -> Zipped h s) -> Jacket j s -> Zipped h s
forall a b. (a -> b) -> a -> b
$ Path j s -> j -> s -> Jacket j s
forall i a. Path i a -> i -> a -> Jacket i a
recompress Path j s
p j
i (Jacket i a -> s
k Jacket i a
as)
{-# INLINE recoil #-}
rezip :: Zipping h a => (h :> a:@i) -> Zipped h a
rezip :: (h :> (a :@ i)) -> Zipped h a
rezip (Zipper h _ _ p i a) = Coil h i a -> Jacket i a -> Zipped h a
forall h a i. Zipping h a => Coil h i a -> Jacket i a -> Zipped h a
recoil Coil h i a
h (Path i a -> i -> a -> Jacket i a
forall i a. Path i a -> i -> a -> Jacket i a
recompress Path i a
p i
i a
a)
{-# INLINE rezip #-}
focusedContext :: (Indexable i p, Zipping h a) => (h :> a:@i) -> Pretext p a a (Zipped h a)
focusedContext :: (h :> (a :@ i)) -> Pretext p a a (Zipped h a)
focusedContext (Zipper h t o p i a) = (forall (f :: * -> *). Functor f => p a (f a) -> f (Zipped h a))
-> Pretext p a a (Zipped h a)
forall (p :: * -> * -> *) a b t.
(forall (f :: * -> *). Functor f => p a (f b) -> f t)
-> Pretext p a b t
Pretext (\p a (f a)
f -> Zipper h i a -> Zipped h a
forall h a i. Zipping h a => (h :> (a :@ i)) -> Zipped h a
rezip (Zipper h i a -> Zipped h a)
-> (a -> Zipper h i a) -> a -> Zipped h a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coil h i a -> Int -> Int -> Path i a -> i -> a -> Zipper h i a
forall h i a.
Ord i =>
Coil h i a -> Int -> Int -> Path i a -> i -> a -> Zipper h i a
Zipper Coil h i a
h Int
t Int
o Path i a
p i
i (a -> Zipped h a) -> f a -> f (Zipped h a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p a (f a) -> i -> a -> f a
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p a (f a)
f i
i a
a)
{-# INLINE focusedContext #-}
data Tape h i a where
Tape :: Track h i a -> i -> Tape h i a
saveTape :: Zipper h i a -> Tape h i a
saveTape :: Zipper h i a -> Tape h i a
saveTape (Zipper Coil h i a
h Int
_ Int
_ Path i a
_ i
i a
_) = Track h i a -> i -> Tape h i a
forall h i a. Track h i a -> i -> Tape h i a
Tape (Coil h i a -> Track h i a
forall h i a. Coil h i a -> Track h i a
peel Coil h i a
h) i
i
{-# INLINE saveTape #-}
restoreTape :: MonadPlus m => Tape h i a -> Zipped h a -> m (Zipper h i a)
restoreTape :: Tape h i a -> Zipped h a -> m (Zipper h i a)
restoreTape (Tape Track h i a
h i
n) = Track h i a -> Zipped h a -> m (Zipper h i a)
forall (m :: * -> *) h i a.
MonadPlus m =>
Track h i a -> Zipped h a -> m (Zipper h i a)
restoreTrack Track h i a
h (Zipped h a -> m (Zipper h i a))
-> (Zipper h i a -> m (Zipper h i a))
-> Zipped h a
-> m (Zipper h i a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> i -> (h :> (a :@ i)) -> m (h :> (a :@ i))
forall (m :: * -> *) i h a.
MonadPlus m =>
i -> (h :> (a :@ i)) -> m (h :> (a :@ i))
moveTo i
n
{-# INLINE restoreTape #-}
restoreNearTape :: MonadPlus m => Tape h i a -> Zipped h a -> m (Zipper h i a)
restoreNearTape :: Tape h i a -> Zipped h a -> m (Zipper h i a)
restoreNearTape (Tape Track h i a
h i
n) Zipped h a
a = (Zipper h i a -> Zipper h i a)
-> m (Zipper h i a) -> m (Zipper h i a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (i -> (h :> (a :@ i)) -> h :> (a :@ i)
forall i h a. i -> (h :> (a :@ i)) -> h :> (a :@ i)
moveToward i
n) (Track h i a -> Zipped h a -> m (Zipper h i a)
forall (m :: * -> *) h i a.
MonadPlus m =>
Track h i a -> Zipped h a -> m (Zipper h i a)
restoreNearTrack Track h i a
h Zipped h a
a)
{-# INLINE restoreNearTape #-}
unsafelyRestoreTape :: Tape h i a -> Zipped h a -> Zipper h i a
unsafelyRestoreTape :: Tape h i a -> Zipped h a -> Zipper h i a
unsafelyRestoreTape (Tape Track h i a
h i
n) = Track h i a -> Zipped h a -> Zipper h i a
forall h i a. Track h i a -> Zipped h a -> Zipper h i a
unsafelyRestoreTrack Track h i a
h (Zipped h a -> Zipper h i a)
-> (Zipper h i a -> Zipper h i a) -> Zipped h a -> Zipper h i a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> i -> (h :> (a :@ i)) -> h :> (a :@ i)
forall i h a. i -> (h :> (a :@ i)) -> h :> (a :@ i)
moveToward i
n
{-# INLINE unsafelyRestoreTape #-}
peel :: Coil h i a -> Track h i a
peel :: Coil h i a -> Track h i a
peel Coil h i a
Coil = Track h i a
forall a. Track Top Int a
Track
peel (Snoc Coil h j s
h AnIndexedTraversal' i s a
l Int
_ Int
_ Path j s
_ j
i Jacket i a -> s
_) = Track h j s
-> j -> AnIndexedTraversal' i s a -> Track (Zipper h j s) i a
forall i h j s a.
Ord i =>
Track h j s
-> j -> AnIndexedTraversal' i s a -> Track (Zipper h j s) i a
Fork (Coil h j s -> Track h j s
forall h i a. Coil h i a -> Track h i a
peel Coil h j s
h) j
i AnIndexedTraversal' i s a
l
{-# INLINE peel #-}
data Track t i a where
Track :: Track Top Int a
Fork :: Ord i => Track h j s -> j -> AnIndexedTraversal' i s a -> Track (Zipper h j s) i a
restoreTrack :: MonadPlus m => Track h i a -> Zipped h a -> m (Zipper h i a)
restoreTrack :: Track h i a -> Zipped h a -> m (Zipper h i a)
restoreTrack Track h i a
Track = (Top :>> a) -> m (Top :>> a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Top :>> a) -> m (Top :>> a))
-> (a -> Top :>> a) -> a -> m (Top :>> a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Top :>> a
forall a. a -> Top :>> a
zipper
restoreTrack (Fork Track h j s
h j
n AnIndexedTraversal' i s a
l) = Track h j s -> Zipped h s -> m (Zipper h j s)
forall (m :: * -> *) h i a.
MonadPlus m =>
Track h i a -> Zipped h a -> m (Zipper h i a)
restoreTrack Track h j s
h (Zipped h s -> m (Zipper h j s))
-> (Zipper h j s -> m (Zipper h i a))
-> Zipped h s
-> m (Zipper h i a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> j -> (h :> (s :@ j)) -> m (h :> (s :@ j))
forall (m :: * -> *) i h a.
MonadPlus m =>
i -> (h :> (a :@ i)) -> m (h :> (a :@ i))
moveTo j
n (Zipper h j s -> m (Zipper h j s))
-> (Zipper h j s -> m (Zipper h i a))
-> Zipper h j s
-> m (Zipper h i a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> AnIndexedTraversal' i s a
-> (h :> (s :@ j)) -> m ((h :> (s :@ j)) :> (a :@ i))
forall (m :: * -> *) i s a h j.
(MonadPlus m, Ord i) =>
AnIndexedTraversal' i s a
-> (h :> (s :@ j)) -> m ((h :> (s :@ j)) :> (a :@ i))
iwithin AnIndexedTraversal' i s a
l
restoreNearTrack :: MonadPlus m => Track h i a -> Zipped h a -> m (Zipper h i a)
restoreNearTrack :: Track h i a -> Zipped h a -> m (Zipper h i a)
restoreNearTrack Track h i a
Track = (Top :>> a) -> m (Top :>> a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Top :>> a) -> m (Top :>> a))
-> (a -> Top :>> a) -> a -> m (Top :>> a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Top :>> a
forall a. a -> Top :>> a
zipper
restoreNearTrack (Fork Track h j s
h j
n AnIndexedTraversal' i s a
l) = Track h j s -> Zipped h s -> m (Zipper h j s)
forall (m :: * -> *) h i a.
MonadPlus m =>
Track h i a -> Zipped h a -> m (Zipper h i a)
restoreNearTrack Track h j s
h (Zipped h s -> m (Zipper h j s))
-> (Zipper h j s -> m (Zipper h i a))
-> Zipped h s
-> m (Zipper h i a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> j -> (h :> (s :@ j)) -> h :> (s :@ j)
forall i h a. i -> (h :> (a :@ i)) -> h :> (a :@ i)
moveToward j
n (Zipper h j s -> Zipper h j s)
-> (Zipper h j s -> m (Zipper (Zipper h j s) i a))
-> Zipper h j s
-> m (Zipper (Zipper h j s) i a)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> AnIndexedTraversal' i s a
-> (h :> (s :@ j)) -> m ((h :> (s :@ j)) :> (a :@ i))
forall (m :: * -> *) i s a h j.
(MonadPlus m, Ord i) =>
AnIndexedTraversal' i s a
-> (h :> (s :@ j)) -> m ((h :> (s :@ j)) :> (a :@ i))
iwithin AnIndexedTraversal' i s a
l
unsafelyRestoreTrack :: Track h i a -> Zipped h a -> Zipper h i a
unsafelyRestoreTrack :: Track h i a -> Zipped h a -> Zipper h i a
unsafelyRestoreTrack Track h i a
Track = Zipped h a -> Zipper h i a
forall a. a -> Top :>> a
zipper
unsafelyRestoreTrack (Fork Track h j s
h j
n AnIndexedTraversal' i s a
l) = Track h j s -> Zipped h s -> Zipper h j s
forall h i a. Track h i a -> Zipped h a -> Zipper h i a
unsafelyRestoreTrack Track h j s
h (Zipped h s -> Zipper h j s)
-> (Zipper h j s -> Zipper (Zipper h j s) i a)
-> Zipped h s
-> Zipper (Zipper h j s) i a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> j -> (h :> (s :@ j)) -> h :> (s :@ j)
forall i h a. i -> (h :> (a :@ i)) -> h :> (a :@ i)
moveToward j
n (Zipper h j s -> Zipper h j s)
-> (Zipper h j s -> Zipper (Zipper h j s) i a)
-> Zipper h j s
-> Zipper (Zipper h j s) i a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> AnIndexedTraversal' i s a
-> (h :> (s :@ j)) -> (h :> (s :@ j)) :> (a :@ i)
forall i s a h j.
Ord i =>
AnIndexedTraversal' i s a
-> (h :> (s :@ j)) -> (h :> (s :@ j)) :> (a :@ i)
ifromWithin AnIndexedTraversal' i s a
l