{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveFunctor #-}

module Cursor.Tree.Demote
    ( treeCursorDemoteElem
    , treeCursorDemoteSubTree
    , DemoteResult(..)
    , treeCursorDemoteElemUnder
    , treeCursorDemoteSubTreeUnder
    ) where

import Data.Validity

import GHC.Generics (Generic)

import Cursor.Tree.Base
import Cursor.Tree.Types

-- | Demotes the current node to the level of its children.
--
-- Example:
--
-- Before:
--
-- >  p
-- >  |- a
-- >  |  |- b
-- >  |- c <--
-- >  |  |- d
-- >  |- e
--
-- After:
--
-- >  p
-- >  |- a
-- >  |  |- b
-- >  |  |- c <--
-- >  |  |- d
-- >  |- e
treeCursorDemoteElem ::
       (a -> b) -> (b -> a) -> TreeCursor a b -> DemoteResult (TreeCursor a b)
treeCursorDemoteElem f g tc =
    case treeAbove tc of
        Nothing -> CannotDemoteTopNode
        Just ta ->
            case treeAboveLefts ta of
                [] -> NoSiblingsToDemoteUnder
                (CNode t ls:ts) ->
                    Demoted $
                    makeTreeCursorWithAbove
                        g
                        (CNode (f $ treeCurrent tc) emptyCForest) $
                    Just
                        TreeAbove
                        { treeAboveLefts = reverse $ unpackCForest ls
                        , treeAboveAbove = Just ta {treeAboveLefts = ts}
                        , treeAboveNode = t
                        , treeAboveRights = unpackCForest $ treeBelow tc
                        }

-- | Demotes the current subtree to the level of its children.
--
-- Example:
--
-- Before:
--
-- >  p
-- >  |- a
-- >  |  |- b
-- >  |- c <--
-- >  |  |- d
-- >  |- e
--
-- After:
--
-- >  p
-- >  |- a
-- >  |  |- b
-- >  |  |- c <--
-- >  |     |- d
-- >  |- e
treeCursorDemoteSubTree ::
       (a -> b) -> (b -> a) -> TreeCursor a b -> DemoteResult (TreeCursor a b)
treeCursorDemoteSubTree f g tc =
    case treeAbove tc of
        Nothing -> CannotDemoteTopNode
        Just ta ->
            case treeAboveLefts ta of
                [] -> NoSiblingsToDemoteUnder
                (CNode t ls:ts) ->
                    Demoted $
                    makeTreeCursorWithAbove g (currentTree f tc) $
                    Just
                        TreeAbove
                        { treeAboveLefts = reverse $ unpackCForest ls
                        , treeAboveAbove = Just ta {treeAboveLefts = ts}
                        , treeAboveNode = t
                        , treeAboveRights = []
                        }

data DemoteResult a
    = CannotDemoteTopNode
    | NoSiblingsToDemoteUnder
    | Demoted a
    deriving (Show, Eq, Generic, Functor)

instance Validity a => Validity (DemoteResult a)

-- | Demotes the current node to the level of its children, by adding two roots.
-- One for the current node and one for its children that are left behind.
--
-- Example:
--
-- Before:
--
-- >  p
-- >  |- a <--
-- >     |- b
--
-- After:
--
-- >  p
-- >  |- <given element 1>
-- >  |  |- a <--
-- >  |- <given element 2>
-- >  |  |- b
treeCursorDemoteElemUnder :: b -> b -> TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorDemoteElemUnder b1 b2 tc = do
    ta <- treeAbove tc
    let ta' =
            ta {treeAboveRights = CNode b2 (treeBelow tc) : treeAboveRights ta}
    pure
        tc
        { treeAbove =
              Just
                  TreeAbove
                  { treeAboveLefts = []
                  , treeAboveAbove = Just ta'
                  , treeAboveNode = b1
                  , treeAboveRights = []
                  }
        , treeBelow = emptyCForest
        }

-- | Demotes the current subtree to the level of its children, by adding a root.
--
-- Example:
--
-- Before:
--
-- >  a <--
-- >  |- b
--
-- After:
--
-- >  <given element>
-- >  |- a <--
-- >     |- b
treeCursorDemoteSubTreeUnder :: b -> TreeCursor a b -> TreeCursor a b
treeCursorDemoteSubTreeUnder b tc =
    tc
    { treeAbove =
          Just
              TreeAbove
              { treeAboveLefts = []
              , treeAboveAbove = treeAbove tc
              , treeAboveNode = b
              , treeAboveRights = []
              }
    }