content: module Matterhorn.Zipper
    ( Zipper
    , fromList
    , toList
    , focus
    , focusHeading
    , left
    , leftL
    , right
    , rightL
    , findRight
    , maybeFindRight
    , updateListBy
    , filterZipper
    , maybeMapZipper
    , isEmpty
    , position
    )
  where
  
  import           Prelude ()
  import           Matterhorn.Prelude hiding (toList)
  
  import           Data.List ( elemIndex )
  import           Data.Maybe ( fromJust )
  import qualified Data.Foldable as F
  import qualified Data.Sequence as Seq
  import qualified Data.CircularList as C
  import           Lens.Micro.Platform
  
  data Zipper a b =
      Zipper { zRing :: C.CList b
             , zTrees :: Seq.Seq (a, Seq.Seq b)
             }
  
  instance F.Foldable (Zipper a) where
      foldMap f = foldMap f .
                  F.toList .
                  mconcat .
                  F.toList .
                  fmap snd .
                  zTrees
  
  instance Functor (Zipper a) where
      fmap f z =
          Zipper { zRing = f <$> zRing z
                 , zTrees = zTrees z & mapped._2.mapped %~ f
                 }
  
  isEmpty :: Zipper a b -> Bool
  isEmpty = C.isEmpty . zRing
  
  position :: (Eq b) => Zipper a b -> Maybe Int
  position z = do
      f <- focus z
      elemIndex f $ concat $ fmap snd $ toList z
  
  -- Move the focus one element to the left
  left :: Zipper a b -> Zipper a b
  left z = z { zRing = C.rotL (zRing z) }
  
  -- A lens on the zipper moved to the left
  leftL :: Lens (Zipper a b) (Zipper a b) (Zipper a b) (Zipper a b)
  leftL = lens left (\ _ b -> right b)
  
  -- Move the focus one element to the right
  right :: Zipper a b -> Zipper a b
  right z = z { zRing = C.rotR (zRing z) }
  
  -- A lens on the zipper moved to the right
  rightL :: Lens (Zipper a b) (Zipper a b) (Zipper a b) (Zipper a b)
  rightL = lens right (\ _ b -> left b)
  
  -- Return the focus element
  focus :: Zipper a b -> Maybe b
  focus = C.focus . zRing
  
  -- Return the heading value corresponding to the focused value, if any
  -- element is in focus
  focusHeading :: (Eq b) => Zipper a b -> Maybe a
  focusHeading z = do
      f <- focus z
      let matchesElems (_, es) = f `elem` es
          matches = filter matchesElems $ toList z
      listToMaybe $ fst <$> matches
  
  -- Turn a list into a wraparound zipper, focusing on the head
  fromList :: (Eq b) => [(a, [b])] -> Zipper a b
  fromList xs =
      let ts = Seq.fromList $ xs & mapped._2 %~ Seq.fromList
          tsList = F.toList $ mconcat $ F.toList $ snd <$> ts
          maybeFocus = if null tsList
                       then id
                       else fromJust . C.rotateTo (tsList !! 0)
      in Zipper { zRing = maybeFocus $ C.fromList tsList
                , zTrees = ts
                }
  
  toList :: Zipper a b -> [(a, [b])]
  toList z = F.toList $ zTrees z & mapped._2 %~ F.toList
  
  -- Shift the focus until a given element is found, or return the
  -- same zipper if none applies
  findRight :: (b -> Bool) -> Zipper a b -> Zipper a b
  findRight f z = fromMaybe z $ maybeFindRight f z
  
  -- Shift the focus until a given element is found, or return
  -- Nothing if none applies
  maybeFindRight :: (b -> Bool) -> Zipper a b -> Maybe (Zipper a b)
  maybeFindRight f z = do
      newRing <- C.findRotateTo f (zRing z)
      return z { zRing = newRing }
  
  -- | Update the zipper's entry list, using the specified function
  -- determine which entry should be selected in the new zipper state.
  updateListBy :: (Eq b)
               => (Maybe b -> b -> Bool)
               -- ^ The comparison function. This is given the previous
               -- zipper's focus value (which is optional) and is given
               -- every element in the new zipper state for comparison.
               -- This should return True for the item in the new zipper
               -- that matches the focused item in the old zipper.
               -> [(a, [b])]
               -- ^ The new zipper list contents.
               -> Zipper a b
               -- ^ The old zipper.
               -> Zipper a b
  updateListBy f newList oldZip = findRight (f (focus oldZip)) $ fromList newList
  
  maybeMapZipper :: (Eq c) => (b -> Maybe c) -> Zipper a b -> Zipper a c
  maybeMapZipper f z =
      let oldTrees = zTrees z
          newTrees = F.toList $ oldTrees & mapped._2 %~ (catMaybes . F.toList . fmap f)
      in fromList newTrees
  
  filterZipper :: (Eq b) => (b -> Bool) -> Zipper a b -> Zipper a b
  filterZipper f oldZip = maintainFocus newZip
    where maintainFocus = findRight ((== focus oldZip) . Just)
          newZip = Zipper { zTrees = zTrees oldZip & mapped._2 %~ Seq.filter f
                          , zRing = C.filterR f (zRing oldZip)
                          }
  