    {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
    {-# OPTIONS -fno-warn-orphans #-}

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

    {- |
       Module     : Data.Tree.NTree.Zipper.TypeDefs
       Copyright  : Copyright (C) 2010 Uwe Schmidt
       License    : MIT

       Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)
       Stability  : stable
       Portability: portable

       Implementation of navigateble trees for
       rose trees. The implementation is done with zippers.
       A description and introductory tutorial about zippers
       can be found in <http://learnyouahaskell.com/zippers>
    -}

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

    module Data.Tree.NTree.Zipper.TypeDefs
    {-
        ( NTZipper
        , NTree
        , toNTZipper
        , fromNTZipper
        )
    -}
    where

    import Data.Tree.Class

    import Data.Tree.NavigatableTree.Class
    import Data.Tree.NavigatableTree.XPathAxis      ( childAxis )

    import Data.Tree.NTree.TypeDefs

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

    -- | Zipper for rose trees
    --
    -- A zipper consist of the current tree and the branches on the way back to the root

    data NTZipper a         = NTZ
                              { ntree   :: (NTree a)
                              , context :: (NTBreadCrumbs a)
                              }
                              deriving (Show)

    -- | The list of unzipped nodes from a current tree back to the root

    type NTBreadCrumbs a    = [NTCrumb a]

    -- | One unzipped step consists of the left siblings, the node info and the right siblings

    data NTCrumb a          = NTC
                              (NTrees a)            -- left side
                              a                     -- node
                              (NTrees a)            -- right side
                              deriving (Show)

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

    -- | Conversion of a rose tree into a navigatable rose tree

    toNTZipper              :: NTree a -> NTZipper a
    toNTZipper t            = NTZ t []

    {-# INLINE toNTZipper #-}

    -- | Conversion of a navigatable rose tree into an ordinary rose tree.
    --
    -- The context, the parts for moving up to the root are just removed from the tree.
    -- So when transforming a navigatable tree by moving around and by changing some nodes,
    -- one has to navigate back
    -- to the root, else that parts are removed from the result

    fromNTZipper            :: NTZipper a -> NTree a
    fromNTZipper            = ntree

    {-# INLINE fromNTZipper #-}

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

    up                      :: NTZipper a -> Maybe (NTZipper a)
    up z
        | isTop z           = Nothing
        | otherwise         = Just $ NTZ (up1 t bc) bcs
        where
        NTZ t (bc : bcs)    = z

    {-# INLINE up #-}

    down                    :: NTZipper a -> Maybe (NTZipper a)
    down (NTZ (NTree n cs) bcs)
              | null cs     = Nothing
              | otherwise   = Just $ NTZ (head cs) (NTC [] n (tail cs) : bcs)

    {-# INLINE down #-}

    toTheRight                   :: NTZipper a -> Maybe (NTZipper a)
    toTheRight z
        | isTop z
          ||
          null rs           = Nothing
        | otherwise         = Just $ NTZ t' (bc' : bcs)
        where
        (NTZ t (bc : bcs))  = z
        (NTC ls n rs)       = bc
        t'                  = head rs
        bc'                 = NTC (t : ls) n (tail rs)

    {-# INLINE toTheRight #-}

    toTheLeft                    :: NTZipper a -> Maybe (NTZipper a)
    toTheLeft z
        | isTop z
          ||
          null ls           = Nothing
        | otherwise         = Just $ NTZ t' (bc' : bcs)
        where
        (NTZ t (bc : bcs))  = z
        (NTC ls n rs)       = bc
        t'                  = head ls
        bc'                 = NTC (tail ls) n (t : rs)

    {-# INLINE toTheLeft #-}

    addToTheLeft            :: NTree a -> NTZipper a -> Maybe (NTZipper a)
    addToTheLeft t z
        | isTop z           = Nothing
        | otherwise         = Just $ NTZ t' (NTC (t:ls) n rs : bcs)
        where
        (NTZ t' (bc : bcs)) = z
        (NTC ls n rs)       = bc
    {-# INLINE addToTheLeft #-}

    addToTheRight            :: NTree a -> NTZipper a -> Maybe (NTZipper a)
    addToTheRight t z
        | isTop z           = Nothing
        | otherwise         = Just $ NTZ t' (NTC ls n (t:rs) : bcs)
        where
        (NTZ t' (bc : bcs)) = z
        (NTC ls n rs)       = bc
    {-# INLINE addToTheRight #-}

    dropFromTheLeft            :: NTZipper a -> Maybe (NTZipper a)
    dropFromTheLeft z
        | isTop z           = Nothing
        | null ls           = Nothing
        | otherwise         = Just $ NTZ t' (NTC (tail ls) n rs : bcs)
        where
        (NTZ t' (bc : bcs)) = z
        (NTC ls n rs)       = bc
    {-# INLINE dropFromTheLeft #-}

    dropFromTheRight        :: NTZipper a -> Maybe (NTZipper a)
    dropFromTheRight z
        | isTop z           = Nothing
        | null rs           = Nothing
        | otherwise         = Just $ NTZ t' (NTC ls n (tail rs) : bcs)
        where
        (NTZ t' (bc : bcs)) = z
        (NTC ls n rs)       = bc
    {-# INLINE dropFromTheRight #-}

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

    isTop                   :: NTZipper a -> Bool
    isTop                   = null . context

    {-# INLINE isTop #-}

    up1                     :: NTree a -> NTCrumb a -> NTree a
    up1 t (NTC ls n rs)     = NTree n (foldl (flip (:)) (t : rs) ls)

    {-# INLINE up1 #-}

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

    instance Functor NTZipper where
        fmap f (NTZ t xs)   = NTZ (fmap f t) (map (fmap f) xs)
        {-# INLINE fmap #-}

    instance Functor NTCrumb where
        fmap f (NTC xs x ys)= NTC (map (fmap f) xs) (f x) (map (fmap f) ys)
        {-# INLINE fmap #-}

    instance Tree NTZipper where
        mkTree n cl         = toNTZipper . mkTree n $ map ntree cl

        getNode             = getNode . ntree
        {-# INLINE getNode #-}
        getChildren         = childAxis
        {-# INLINE getChildren #-}

        changeNode     cf t = t { ntree = changeNode cf (ntree t) }
        changeChildren cf t = t { ntree = setChildren (map ntree . cf . childAxis $ t) (ntree t) }

        foldTree f          = foldTree f . ntree
        {-# INLINE foldTree #-}

    instance NavigatableTree NTZipper where
        mvDown              = down
        {-# INLINE mvDown #-}

        mvUp                = up
        {-# INLINE mvUp #-}

        mvLeft              = toTheLeft
        {-# INLINE mvLeft #-}

        mvRight             = toTheRight
        {-# INLINE mvRight #-}

    instance NavigatableTreeToTree NTZipper NTree where
        fromTree            = toNTZipper
        {-# INLINE fromTree #-}

        toTree              = fromNTZipper
        {-# INLINE toTree #-}

    instance NavigatableTreeModify NTZipper NTree where
        addTreeLeft         = addToTheLeft
        {-# INLINE addTreeLeft #-}

        addTreeRight        = addToTheRight
        {-# INLINE addTreeRight #-}

        dropTreeLeft        = dropFromTheLeft
        {-# INLINE dropTreeLeft #-}

        dropTreeRight       = dropFromTheRight
        {-# INLINE dropTreeRight #-}

        substThisTree t nt  = nt { ntree = t }
        {-# INLINE substThisTree #-}

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