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

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

import Control.DeepSeq
import Cursor.Tree.Base
import Cursor.Tree.Types
import Data.Validity
import GHC.Generics (Generic)

-- | 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 :: (a -> b)
-> (b -> a) -> TreeCursor a b -> DemoteResult (TreeCursor a b)
treeCursorDemoteElem a -> b
f b -> a
g TreeCursor a b
tc =
  case TreeCursor a b -> Maybe (TreeAbove b)
forall a b. TreeCursor a b -> Maybe (TreeAbove b)
treeAbove TreeCursor a b
tc of
    Maybe (TreeAbove b)
Nothing -> DemoteResult (TreeCursor a b)
forall a. DemoteResult a
CannotDemoteTopNode
    Just TreeAbove b
ta ->
      case TreeAbove b -> [CTree b]
forall b. TreeAbove b -> [CTree b]
treeAboveLefts TreeAbove b
ta of
        [] -> DemoteResult (TreeCursor a b)
forall a. DemoteResult a
NoSiblingsToDemoteUnder
        (CNode b
t CForest b
ls : [CTree b]
ts) ->
          TreeCursor a b -> DemoteResult (TreeCursor a b)
forall a. a -> DemoteResult a
Demoted (TreeCursor a b -> DemoteResult (TreeCursor a b))
-> TreeCursor a b -> DemoteResult (TreeCursor a b)
forall a b. (a -> b) -> a -> b
$
            (b -> a) -> CTree b -> Maybe (TreeAbove b) -> TreeCursor a b
forall b a.
(b -> a) -> CTree b -> Maybe (TreeAbove b) -> TreeCursor a b
makeTreeCursorWithAbove b -> a
g (b -> CForest b -> CTree b
forall a. a -> CForest a -> CTree a
CNode (a -> b
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ TreeCursor a b -> a
forall a b. TreeCursor a b -> a
treeCurrent TreeCursor a b
tc) CForest b
forall a. CForest a
emptyCForest) (Maybe (TreeAbove b) -> TreeCursor a b)
-> Maybe (TreeAbove b) -> TreeCursor a b
forall a b. (a -> b) -> a -> b
$
              TreeAbove b -> Maybe (TreeAbove b)
forall a. a -> Maybe a
Just
                TreeAbove :: forall b.
[CTree b] -> Maybe (TreeAbove b) -> b -> [CTree b] -> TreeAbove b
TreeAbove
                  { treeAboveLefts :: [CTree b]
treeAboveLefts = [CTree b] -> [CTree b]
forall a. [a] -> [a]
reverse ([CTree b] -> [CTree b]) -> [CTree b] -> [CTree b]
forall a b. (a -> b) -> a -> b
$ CForest b -> [CTree b]
forall a. CForest a -> [CTree a]
unpackCForest CForest b
ls,
                    treeAboveAbove :: Maybe (TreeAbove b)
treeAboveAbove = TreeAbove b -> Maybe (TreeAbove b)
forall a. a -> Maybe a
Just TreeAbove b
ta {treeAboveLefts :: [CTree b]
treeAboveLefts = [CTree b]
ts},
                    treeAboveNode :: b
treeAboveNode = b
t,
                    treeAboveRights :: [CTree b]
treeAboveRights = CForest b -> [CTree b]
forall a. CForest a -> [CTree a]
unpackCForest (CForest b -> [CTree b]) -> CForest b -> [CTree b]
forall a b. (a -> b) -> a -> b
$ TreeCursor a b -> CForest b
forall a b. TreeCursor a b -> CForest b
treeBelow TreeCursor a b
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 :: (a -> b)
-> (b -> a) -> TreeCursor a b -> DemoteResult (TreeCursor a b)
treeCursorDemoteSubTree a -> b
f b -> a
g TreeCursor a b
tc =
  case TreeCursor a b -> Maybe (TreeAbove b)
forall a b. TreeCursor a b -> Maybe (TreeAbove b)
treeAbove TreeCursor a b
tc of
    Maybe (TreeAbove b)
Nothing -> DemoteResult (TreeCursor a b)
forall a. DemoteResult a
CannotDemoteTopNode
    Just TreeAbove b
ta ->
      case TreeAbove b -> [CTree b]
forall b. TreeAbove b -> [CTree b]
treeAboveLefts TreeAbove b
ta of
        [] -> DemoteResult (TreeCursor a b)
forall a. DemoteResult a
NoSiblingsToDemoteUnder
        (CNode b
t CForest b
ls : [CTree b]
ts) ->
          TreeCursor a b -> DemoteResult (TreeCursor a b)
forall a. a -> DemoteResult a
Demoted (TreeCursor a b -> DemoteResult (TreeCursor a b))
-> TreeCursor a b -> DemoteResult (TreeCursor a b)
forall a b. (a -> b) -> a -> b
$
            (b -> a) -> CTree b -> Maybe (TreeAbove b) -> TreeCursor a b
forall b a.
(b -> a) -> CTree b -> Maybe (TreeAbove b) -> TreeCursor a b
makeTreeCursorWithAbove b -> a
g ((a -> b) -> TreeCursor a b -> CTree b
forall a b. (a -> b) -> TreeCursor a b -> CTree b
currentTree a -> b
f TreeCursor a b
tc) (Maybe (TreeAbove b) -> TreeCursor a b)
-> Maybe (TreeAbove b) -> TreeCursor a b
forall a b. (a -> b) -> a -> b
$
              TreeAbove b -> Maybe (TreeAbove b)
forall a. a -> Maybe a
Just
                TreeAbove :: forall b.
[CTree b] -> Maybe (TreeAbove b) -> b -> [CTree b] -> TreeAbove b
TreeAbove
                  { treeAboveLefts :: [CTree b]
treeAboveLefts = [CTree b] -> [CTree b]
forall a. [a] -> [a]
reverse ([CTree b] -> [CTree b]) -> [CTree b] -> [CTree b]
forall a b. (a -> b) -> a -> b
$ CForest b -> [CTree b]
forall a. CForest a -> [CTree a]
unpackCForest CForest b
ls,
                    treeAboveAbove :: Maybe (TreeAbove b)
treeAboveAbove = TreeAbove b -> Maybe (TreeAbove b)
forall a. a -> Maybe a
Just TreeAbove b
ta {treeAboveLefts :: [CTree b]
treeAboveLefts = [CTree b]
ts},
                    treeAboveNode :: b
treeAboveNode = b
t,
                    treeAboveRights :: [CTree b]
treeAboveRights = []
                  }

data DemoteResult a
  = CannotDemoteTopNode
  | NoSiblingsToDemoteUnder
  | Demoted a
  deriving (Int -> DemoteResult a -> ShowS
[DemoteResult a] -> ShowS
DemoteResult a -> String
(Int -> DemoteResult a -> ShowS)
-> (DemoteResult a -> String)
-> ([DemoteResult a] -> ShowS)
-> Show (DemoteResult a)
forall a. Show a => Int -> DemoteResult a -> ShowS
forall a. Show a => [DemoteResult a] -> ShowS
forall a. Show a => DemoteResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DemoteResult a] -> ShowS
$cshowList :: forall a. Show a => [DemoteResult a] -> ShowS
show :: DemoteResult a -> String
$cshow :: forall a. Show a => DemoteResult a -> String
showsPrec :: Int -> DemoteResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> DemoteResult a -> ShowS
Show, DemoteResult a -> DemoteResult a -> Bool
(DemoteResult a -> DemoteResult a -> Bool)
-> (DemoteResult a -> DemoteResult a -> Bool)
-> Eq (DemoteResult a)
forall a. Eq a => DemoteResult a -> DemoteResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DemoteResult a -> DemoteResult a -> Bool
$c/= :: forall a. Eq a => DemoteResult a -> DemoteResult a -> Bool
== :: DemoteResult a -> DemoteResult a -> Bool
$c== :: forall a. Eq a => DemoteResult a -> DemoteResult a -> Bool
Eq, (forall x. DemoteResult a -> Rep (DemoteResult a) x)
-> (forall x. Rep (DemoteResult a) x -> DemoteResult a)
-> Generic (DemoteResult a)
forall x. Rep (DemoteResult a) x -> DemoteResult a
forall x. DemoteResult a -> Rep (DemoteResult a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (DemoteResult a) x -> DemoteResult a
forall a x. DemoteResult a -> Rep (DemoteResult a) x
$cto :: forall a x. Rep (DemoteResult a) x -> DemoteResult a
$cfrom :: forall a x. DemoteResult a -> Rep (DemoteResult a) x
Generic, a -> DemoteResult b -> DemoteResult a
(a -> b) -> DemoteResult a -> DemoteResult b
(forall a b. (a -> b) -> DemoteResult a -> DemoteResult b)
-> (forall a b. a -> DemoteResult b -> DemoteResult a)
-> Functor DemoteResult
forall a b. a -> DemoteResult b -> DemoteResult a
forall a b. (a -> b) -> DemoteResult a -> DemoteResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> DemoteResult b -> DemoteResult a
$c<$ :: forall a b. a -> DemoteResult b -> DemoteResult a
fmap :: (a -> b) -> DemoteResult a -> DemoteResult b
$cfmap :: forall a b. (a -> b) -> DemoteResult a -> DemoteResult b
Functor)

instance Validity a => Validity (DemoteResult a)

instance NFData a => NFData (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 :: b -> b -> TreeCursor a b -> Maybe (TreeCursor a b)
treeCursorDemoteElemUnder b
b1 b
b2 TreeCursor a b
tc = do
  TreeAbove b
ta <- TreeCursor a b -> Maybe (TreeAbove b)
forall a b. TreeCursor a b -> Maybe (TreeAbove b)
treeAbove TreeCursor a b
tc
  let ta' :: TreeAbove b
ta' = TreeAbove b
ta {treeAboveRights :: [CTree b]
treeAboveRights = b -> CForest b -> CTree b
forall a. a -> CForest a -> CTree a
CNode b
b2 (TreeCursor a b -> CForest b
forall a b. TreeCursor a b -> CForest b
treeBelow TreeCursor a b
tc) CTree b -> [CTree b] -> [CTree b]
forall a. a -> [a] -> [a]
: TreeAbove b -> [CTree b]
forall b. TreeAbove b -> [CTree b]
treeAboveRights TreeAbove b
ta}
  TreeCursor a b -> Maybe (TreeCursor a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    TreeCursor a b
tc
      { treeAbove :: Maybe (TreeAbove b)
treeAbove =
          TreeAbove b -> Maybe (TreeAbove b)
forall a. a -> Maybe a
Just
            TreeAbove :: forall b.
[CTree b] -> Maybe (TreeAbove b) -> b -> [CTree b] -> TreeAbove b
TreeAbove
              { treeAboveLefts :: [CTree b]
treeAboveLefts = [],
                treeAboveAbove :: Maybe (TreeAbove b)
treeAboveAbove = TreeAbove b -> Maybe (TreeAbove b)
forall a. a -> Maybe a
Just TreeAbove b
ta',
                treeAboveNode :: b
treeAboveNode = b
b1,
                treeAboveRights :: [CTree b]
treeAboveRights = []
              },
        treeBelow :: CForest b
treeBelow = CForest b
forall a. CForest a
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 -> TreeCursor a b -> TreeCursor a b
treeCursorDemoteSubTreeUnder b
b TreeCursor a b
tc =
  TreeCursor a b
tc
    { treeAbove :: Maybe (TreeAbove b)
treeAbove =
        TreeAbove b -> Maybe (TreeAbove b)
forall a. a -> Maybe a
Just
          TreeAbove :: forall b.
[CTree b] -> Maybe (TreeAbove b) -> b -> [CTree b] -> TreeAbove b
TreeAbove
            { treeAboveLefts :: [CTree b]
treeAboveLefts = [],
              treeAboveAbove :: Maybe (TreeAbove b)
treeAboveAbove = TreeCursor a b -> Maybe (TreeAbove b)
forall a b. TreeCursor a b -> Maybe (TreeAbove b)
treeAbove TreeCursor a b
tc,
              treeAboveNode :: b
treeAboveNode = b
b,
              treeAboveRights :: [CTree b]
treeAboveRights = []
            }
    }