{-# LANGUAGE CPP #-}{-# LANGUAGE GADTs #-}{-# LANGUAGE Rank2Types #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE ScopedTypeVariables #-}{-# LANGUAGE UndecidableInstances #-}{-# LANGUAGE MultiParamTypeClasses #-}{-# LANGUAGE FunctionalDependencies #-}#ifdef TRUSTWORTHY{-# LANGUAGE Trustworthy #-}#endif------------------------------------------------------------------------------- |-- Module : Control.Lens.Internal.Level-- Copyright : (C) 2012-2013 Edward Kmett-- License : BSD-style (see the file LICENSE)-- Maintainer : Edward Kmett <ekmett@gmail.com>-- Stability : experimental-- Portability : non-portable---- This module provides implementation details of the combinators in-- "Control.Lens.Level", which provides for the breadth-first 'Control.Lens.Traversal.Traversal' of-- an arbitrary 'Control.Lens.Traversal.Traversal'.----------------------------------------------------------------------------moduleControl.Lens.Internal.Level(-- * LevelsLevel(..),Deepening(..),deepening,Flows(..))whereimportControl.ApplicativeimportControl.CategoryimportControl.ComonadimportData.FoldableimportData.Functor.ApplyimportData.IntimportData.SemigroupimportData.TraversableimportData.WordimportPreludehiding((.),id)-------------------------------------------------------------------------------- Levels-------------------------------------------------------------------------------- | This data type represents a path-compressed copy of one level of a source-- data structure. We can safely use path-compression because we know the depth-- of the tree.---- Path compression is performed by viewing a 'Level' as a PATRICIA trie of the-- paths into the structure to leaves at a given depth, similar in many ways-- to a 'Data.IntMap.IntMap', but unlike a regular PATRICIA trie we do not need-- to store the mask bits merely the depth of the fork.---- One invariant of this structure is that underneath a 'Two' node you will not-- find any 'Zero' nodes, so 'Zero' can only occur at the root.dataLevelia=Two{-# UNPACK #-}!Word!(Levelia)!(Levelia)|Oneia|Zeroderiving(Eq,Ord,Show,Read)-- | Append a pair of 'Level' values to get a new 'Level' with path compression.---- As the 'Level' type is user-visible, we do not expose this as an illegal-- 'Semigroup' instance, and just use it directly in 'Deepening' as needed.lappend::Levelia->Levelia->LevelialappendZeroZero=ZerolappendZeror@One{}=rlappendl@One{}Zero=llappendZero(Twonlr)=Two(n+1)lrlappend(Twonlr)Zero=Two(n+1)lrlappendlr=Two0lr{-# INLINE lappend #-}instanceFunctor(Leveli)wherefmapf=gowherego(Twonlr)=Twon(gol)(gor)go(Oneia)=Onei(fa)goZero=Zero{-# INLINE fmap #-}instanceFoldable(Leveli)wherefoldMapf=gowherego(Two_lr)=gol`mappend`gorgo(One_a)=fagoZero=mempty{-# INLINE foldMap #-}instanceTraversable(Leveli)wheretraversef=gowherego(Twonlr)=Twon<$>gol<*>gorgo(Oneia)=Onei<$>fagoZero=pureZero{-# INLINE traverse #-}-------------------------------------------------------------------------------- Generating Levels-------------------------------------------------------------------------------- | This is an illegal 'Monoid' used to construct a single 'Level'.newtypeDeepeningia=Deepening{runDeepening::forallr.Int->(Levelia->Bool->r)->r}instanceSemigroup(Deepeningia)whereDeepeningl<>Deepeningr=Deepening$\nk->casenof0->kZeroTrue_->letn'=n-1inln'$\xa->rn'$\yb->k(lappendxy)(a||b){-# INLINE (<>) #-}-- | This is an illegal 'Monoid'.instanceMonoid(Deepeningia)wheremempty=Deepening$\_k->kZeroFalse{-# INLINE mempty #-}mappend(Deepeningl)(Deepeningr)=Deepening$\nk->casenof0->kZeroTrue_->letn'=n-1inln'$\xa->rn'$\yb->k(lappendxy)(a||b){-# INLINE mappend #-}-- | Generate the leaf of a given 'Deepening' based on whether or not we're at the correct depth.deepening::i->a->Deepeningiadeepeningia=Deepening$\nk->k(ifn==0thenOneiaelseZero)False{-# INLINE deepening #-}-------------------------------------------------------------------------------- Reassembling Levels-------------------------------------------------------------------------------- | This is an illegal 'Applicative' used to replace the contents of a list of consecutive 'Level' values-- representing each layer of a structure into the original shape that they were derived from.---- Attempting to 'Flow' something back into a shape other than the one it was taken from will fail.newtypeFlowsiba=Flows{runFlows::[Levelib]->a}instanceFunctor(Flowsib)wherefmapf(Flowsg)=Flows(f.g){-# INLINE fmap #-}-- | Walk down one constructor in a 'Level', veering left.triml::Levelib->Levelibtriml(Two0l_)=ltriml(Twonlr)=Two(n-1)lrtrimlx=x{-# INLINE triml #-}-- | Walk down one constructor in a 'Level', veering right.trimr::Levelib->Levelibtrimr(Two0_r)=rtrimr(Twonlr)=Two(n-1)lrtrimrx=x{-# INLINE trimr #-}instanceApply(Flowsib)whereFlowsmf<.>Flowsma=Flows$\xss->casexssof[]->mf[](ma[])(_:xs)->mf(triml<$>xs)$ma(trimr<$>xs){-# INLINE (<.>) #-}-- | This is an illegal 'Applicative'.instanceApplicative(Flowsib)wherepurea=Flows(consta){-# INLINE pure #-}Flowsmf<*>Flowsma=Flows$\xss->casexssof[]->mf[](ma[])(_:xs)->mf(triml<$>xs)$ma(trimr<$>xs){-# INLINE (<*>) #-}