{-# LANGUAGE CPP #-}{-# LANGUAGE GADTs #-}{-# LANGUAGE TypeFamilies #-}{-# LANGUAGE TypeOperators #-}{-# LANGUAGE EmptyDataDecls #-}{-# LANGUAGE KindSignatures #-}{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE UndecidableInstances #-}{-# LANGUAGE MultiParamTypeClasses #-}#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704{-# LANGUAGE Trustworthy #-}#endif------------------------------------------------------------------------------- |-- Module : Control.Lens.Zipper-- Copyright : (C) 2012 Edward Kmett-- License : BSD-style (see the file LICENSE)-- Maintainer : Edward Kmett <ekmett@gmail.com>-- Stability : experimental-- Portability : non-portable---- This module provides a 'Zipper' with fairly strong type checking guarantees.---- The code here is inspired by Brandon Simmons' @zippo@ package, but uses-- a slightly different approach to represent the 'Zipper' that makes the whole thing-- look like his breadcrumb trail, and can move side-to-side through traversals.---- Some examples types:---- [@'Top' ':>' a@] represents a trivial 'Zipper' with its focus at the root.---- [@'Top' ':>' 'Data.Tree.Tree' a ':>' a@] represents a zipper that starts with a -- 'Data.Tree.Tree' and descends in a single step to values of type @a@.---- [@'Top' ':>' 'Data.Tree.Tree' a ':>' 'Data.Tree.Tree' a ':>' 'Data.Tree.Tree' a@] represents a 'Zipper' into a-- 'Data.Tree.Tree' with an intermediate bookmarked 'Data.Tree.Tree',-- focusing in yet another 'Data.Tree.Tree'.---- Since individual levels of a zipper are managed by an arbitrary 'Traversal',-- you can move left and right through the 'Traversal' selecting neighboring elements.---- >>> zipper ("hello","world") & down _1 & fromWithin traverse & focus .~ 'J' & rightmost & focus .~ 'y' & rezip-- ("Jelly","world")---- This is particularly powerful when compiled with 'Control.Lens.Plated.plate',-- 'Data.Data.Lens.uniplate' or 'Data.Data.Lens.biplate' for walking down into-- self-similar children in syntax trees and other structures.-----------------------------------------------------------------------------moduleControl.Lens.Zipper(-- * ZippersTop(),(:>)(),zipper-- ** Focusing,focus-- ** Horizontal movement,up,down,within,fromWithin-- ** Lateral movement,left,left1,lefts,lefts1,leftmost,right,right1,rights,rights1,rightmost,goto,goto1,coordinate,width-- ** Closing the Zipper,rezip,Zipped,Zipper()-- ** Saving your Progress,Tape(),save,restore,restore1,unsafelyRestore)whereimportControl.ApplicativeimportControl.CategoryimportControl.ComonadimportControl.Monad((>=>))importControl.Lens.IndexedimportControl.Lens.IndexedLensimportControl.Lens.InternalimportControl.Lens.TraversalimportControl.Lens.TypeimportData.List.NonEmptyasNonEmptyimportPreludehiding((.),id)-- $setup-- >>> :m + Control.Lens-- | This is used to represent the 'Top' of the 'Zipper'.---- Every 'Zipper' starts with 'Top'.---- /e.g./ @'Top' ':>' a@ is the trivial zipper.dataTopinfixl9:>-- | This is the type of a 'Zipper'. It visually resembes a 'breadcrumb trail' as-- used in website navigation. Each breadcrumb in the trail represents a level you-- can move up to.---- This type operator associates to the left, so you can use a type like---- @'Top' ':>' ('String','Double') ':>' 'String' ':>' 'Char'@---- to represent a zipper from @('String','Double')@ down to 'Char' that has an intermediate-- crumb for the 'String' containing the 'Char'.datap:>a=Zipper(Coilpa){-# UNPACK #-}!(Levela)-- | This represents the type a zipper will have when it is fully 'Zipped' back up.typefamilyZippedhatypeinstanceZippedTopa=atypeinstanceZipped(h:>b)a=Zippedhb-- | 'Coil' is used internally in the definition of a 'Zipper'.dataCoil::*->*->*whereCoil::CoilTopaSnoc::Coilhb->{-# UNPACK #-}!Int->SimpleLensLike(Bazaaraa)ba->[b]->(NonEmptya->b)->[b]->Coil(h:>b)a-- | This 'Lens' views the current target of the 'zipper'.focus::SimpleIndexedLens(Tape(h:>a))(h:>a)afocus=index$\f(Zipperh(Levelnlar))->(\a'->Zipperh(Levelnla'r))<$>f(Tape(peelh)n)a{-# INLINE focus #-}-- | Construct a 'zipper' that can explore anything.zipper::a->Top:>azippera=ZipperCoil(Level0[]a[]){-# INLINE zipper #-}-- | Return the index into the current 'Traversal'.---- @'goto' ('coordinate' l) l = Just'@coordinate::(a:>b)->Intcoordinate(Zipper_(Leveln___))=n{-# INLINE coordinate #-}-- | Move the 'zipper' 'up', closing the current level and focusing on the parent element.up::(a:>b:>c)->a:>bup(Zipper(Snochn_lskrs)w)=Zipperh(Levelnls(k(rezipLevelw))rs){-# INLINE up #-}-- | Pull the 'zipper' 'left' within the current 'Traversal'.left::(a:>b)->Maybe(a:>b)left(Zipperhw)=Zipperh<$>leftLevelw{-# INLINE left #-}-- | Try to pull the 'zipper' one entry to the 'left'.---- If the entry to the left doesn't exist, then stay still.left1::(a:>b)->a:>bleft1(Zipperhw)=Zipperh$left1Levelw{-# INLINE left1 #-}-- | Pull the entry one entry to the 'right'right::(a:>b)->Maybe(a:>b)right(Zipperhw)=Zipperh<$>rightLevelw{-# INLINE right #-}-- | Try to pull the 'zipper' one entry to the 'right'.---- If the entry doesn't exist, then stay still.right1::(a:>b)->a:>bright1(Zipperhw)=Zipperh$right1Levelw{-# INLINE right1 #-}-- | Try to pull the 'zipper' @n@ entries to the 'right', returning 'Nothing' if you pull too far and run out of entries.---- Passing a negative @n@ will move @-n@ entries to the 'left'.rights::Int->(h:>a)->Maybe(h:>a)rightsnz|n<0=lefts(-n)z|otherwise=gonzwherego0c=Justcgokc=caserightcofNothing->NothingJustc'->go(k-1)c'-- | Try to pull the 'zipper' @n@ entries to the 'left', returning 'Nothing' if you pull too far and run out of entries.lefts::Int->(h:>a)->Maybe(h:>a)leftskz|coordinatez<k=Nothing|otherwise=Just(lefts1kz)-- | Try to pull the 'zipper' @n@ entries to the 'left'. Stopping at the first entry if you run out of entries.---- Passing a negative @n@ will move to @-n@ entries the right, and will return the last entry if you run out of entries.lefts1::Int->(h:>a)->h:>alefts1nz|n<0=rights1(-n)z|otherwise=gonzwherego0c=cgokc=caseleftcofNothing->cJustc'->go(k-1)c'-- | Try to pull the 'zipper' @n@ entries to the 'right'. Stopping at the last entry if you run out of entries.---- Passing a negative number will move to the left and will return the first entry if you run out of entries.rights1::Int->(h:>a)->h:>arights1nz|n<0=lefts1(-n)z|otherwise=gonzwherego0c=cgokc=caserightcofNothing->cJustc'->go(k-1)c'-- | Returns the number of siblings at the current level in the 'zipper'.---- @'width' z '>=' 1@---- /NB:/ If the current 'Traversal' targets an infinite number of elements then this may not terminate.width::(a:>b)->Intwidth(Zipper_w)=levelWidthw{-# INLINE width #-}-- | Move the 'zipper' horizontally to the element in the @n@th position in the current level. (absolutely indexed, starting with the 'leftmost' as @0@)---- This returns 'Nothing' if the target element doesn't exist.---- @'goto' n = 'rights' n . 'leftmost'@goto::Int->(a:>b)->Maybe(a:>b)goton=rightsn.leftmost{-# INLINE goto #-}-- | Move the 'zipper' horizontally to the element in the @n@th position of the current level. (absolutely indexed, starting with the 'leftmost' as @0@)---- If the element at that position doesn't exist, then this will clamp to the range @0 <= n < 'width' z@ and return the element there.goto1::Int->(a:>b)->a:>bgoto1n=rights1n.leftmost{-# INLINE goto1 #-}-- | Move to the left-most position of the current 'Traversal'.leftmost::(a:>b)->a:>bleftmost(Zipperhw)=Zipperh$leftmostLevelw{-# INLINE leftmost #-}-- | Move to the right-most position of the current 'Traversal'.rightmost::(a:>b)->a:>brightmost(Zipperhw)=Zipperh$rightmostLevelw{-# INLINE rightmost #-}-- | Step down into a 'Lens'. This is a constrained form of 'fromWithin' for when you know-- there is precisely one target.---- @-- 'down' :: 'Simple' 'Lens' b c -> (a :> b) -> a :> b :> c-- 'down' :: 'Simple' 'Iso' b c -> (a :> b) -> a :> b :> c-- @down::SimpleLensLike(Contextcc)bc->(a:>b)->a:>b:>cdownl(Zipperh(Levelnlsbrs))=casel(Contextid)bofContextkc->Zipper(Snochn(cloneLensl)ls(k.extract)rs)(Level0[]c[]){-# INLINE down #-}-- | Step down into the 'leftmost' entry of a 'Traversal'.---- @-- 'within' :: 'Simple' 'Traversal' b c -> (a :> b) -> Maybe (a :> b :> c)-- 'within' :: 'Simple' 'Lens' b c -> (a :> b) -> Maybe (a :> b :> c)-- 'within' :: 'Simple' 'Iso' b c -> (a :> b) -> Maybe (a :> b :> c)-- @within::SimpleLensLike(Bazaarcc)bc->(a:>b)->Maybe(a:>b:>c)withinl(Zipperh(Levelnlsbrs))=casepartsOf'l(Contextid)bofContext_[]->NothingContextk(c:cs)->Just(Zipper(Snochnlls(k.NonEmpty.toList)rs)(Level0[]ccs)){-# INLINE within #-}-- | Unsafely step down into a 'Traversal' that is /assumed/ to be non-empty.---- If this invariant is not met then this will usually result in an error!---- @-- 'fromWithin' :: 'Simple' 'Traversal' b c -> (a :> b) -> a :> b :> c-- 'fromWithin' :: 'Simple' 'Lens' b c -> (a :> b) -> a :> b :> c-- 'fromWithin' :: 'Simple' 'Iso' b c -> (a :> b) -> a :> b :> c-- @---- You can reason about this function as if the definition was:---- @'fromWithin' l ≡ 'fromJust' '.' 'within' l@---- but it is lazier in such a way that if this invariant is violated, some code-- can still succeed if it is lazy enough in the use of the focused value.fromWithin::SimpleLensLike(Bazaarcc)bc->(a:>b)->a:>b:>cfromWithinl(Zipperh(Levelnlsbrs))=casepartsOf'l(Contextid)bofContextkcs->Zipper(Snochnlls(k.NonEmpty.toList)rs)(Level0[](Prelude.headcs)(Prelude.tailcs)){-# INLINE fromWithin #-}-- | This enables us to pull the 'zipper' back up to the 'Top'.classZipperhawhererecoil::Coilha->NonEmptya->ZippedhainstanceZipperTopawhererecoilCoil=extractinstanceZipperhb=>Zipper(h:>b)cwhererecoil(Snoch__lskrs)as=recoilh(NonEmpty.fromList(Prelude.reversels++kas:rs))-- | Close something back up that you opened as a 'zipper'.rezip::Zipperha=>(h:>a)->Zippedharezip(Zipperhw)=recoilh(rezipLevelw){-# INLINE rezip #-}-- | This is used to peel off the path information from a 'Coil' for use when saving the current path for later replay.peel::Coilha->TrackhapeelCoil=Trackpeel(Snochnl___)=Fork(peelh)nldataTrack::*->*->*whereTrack::TrackTopaFork::Trackhb->{-# UNPACK #-}!Int->SimpleLensLike(Bazaaraa)ba->Track(h:>b)arestoreTrack::Trackha->Zippedha->Maybe(h:>a)restoreTrackTrack=Just.zipperrestoreTrack(Forkhnl)=restoreTrackh>=>rightsn>=>withinlrestoreTrack1::Trackha->Zippedha->Maybe(h:>a)restoreTrack1Track=Just.zipperrestoreTrack1(Forkhnl)=restoreTrack1h>=>rights1n>>>withinlunsafelyRestoreTrack::Trackha->Zippedha->h:>aunsafelyRestoreTrackTrack=zipperunsafelyRestoreTrack(Forkhnl)=unsafelyRestoreTrackh>>>rights1n>>>fromWithinl-- | A 'Tape' is a recorded path through the 'Traversal' chain of a 'Zipper'.dataTapekwhereTape::Trackha->{-# UNPACK #-}!Int->Tape(h:>a)-- | Save the current path as as a 'Tape' we can play back later.save::(a:>b)->Tape(a:>b)save(Zipperh(Leveln___))=Tape(peelh)n{-# INLINE save #-}-- | Restore ourselves to a previously recorded position precisely.---- If the position does not exist, then fail.restore::Tape(h:>a)->Zippedha->Maybe(h:>a)restore(Tapehn)=restoreTrackh>=>rightsn{-# INLINE restore #-}-- | Restore ourselves to a previously recorded position.---- When moving left to right through a 'Traversal', if this will clamp at each level to the range @0 <= k < width@,-- so the only failures will occur when one of the sequence of downward traversals find no targets.restore1::Tape(h:>a)->Zippedha->Maybe(h:>a)restore1(Tapehn)a=rights1n<$>restoreTrack1ha{-# INLINE restore1 #-}-- | Restore ourselves to a previously recorded position.---- This assumes that nothing has been done in the meantime to affect the existence of anything on the entire path.---- Motions left or right are clamped, but all traversals included on the 'Tape' are assumed to be non-empty.---- Violate these assumptions at your own risk.unsafelyRestore::Tape(h:>a)->Zippedha->h:>aunsafelyRestore(Tapehn)=unsafelyRestoreTrackh>>>rights1n{-# INLINE unsafelyRestore #-}