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

module Cursor.Tree.Swap
  ( treeCursorSwapPrev,
    treeCursorSwapNext,
    SwapResult (..),
  )
where

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

-- | Swaps the current node with the previous node on the same level
--
-- Example:
--
-- Before:
--
-- > p
-- > |- a
-- > |- b <--
--
-- After:
--
-- > p
-- > |- b <--
-- > |- a
treeCursorSwapPrev :: TreeCursor a b -> SwapResult (TreeCursor a b)
treeCursorSwapPrev :: TreeCursor a b -> SwapResult (TreeCursor a b)
treeCursorSwapPrev 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 -> SwapResult (TreeCursor a b)
forall a. SwapResult a
SwapperIsTopNode
    Just TreeAbove b
ta ->
      case TreeAbove b -> [CTree b]
forall b. TreeAbove b -> [CTree b]
treeAboveLefts TreeAbove b
ta of
        [] -> SwapResult (TreeCursor a b)
forall a. SwapResult a
NoSiblingsToSwapWith
        (CTree b
t : [CTree b]
ts) ->
          TreeCursor a b -> SwapResult (TreeCursor a b)
forall a. a -> SwapResult a
Swapped (TreeCursor a b -> SwapResult (TreeCursor a b))
-> TreeCursor a b -> SwapResult (TreeCursor a b)
forall a b. (a -> b) -> a -> b
$
            TreeCursor a b
tc {treeAbove :: Maybe (TreeAbove b)
treeAbove = TreeAbove b -> Maybe (TreeAbove b)
forall a. a -> Maybe a
Just TreeAbove b
ta {treeAboveLefts :: [CTree b]
treeAboveLefts = [CTree b]
ts, treeAboveRights :: [CTree b]
treeAboveRights = CTree b
t 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}}

-- | Swaps the current node with the next node on the same level
--
-- Example:
--
-- Before:
--
-- > p
-- > |- a <--
-- > |- b
--
-- After:
--
-- > p
-- > |- b
-- > |- a <--
treeCursorSwapNext :: TreeCursor a b -> SwapResult (TreeCursor a b)
treeCursorSwapNext :: TreeCursor a b -> SwapResult (TreeCursor a b)
treeCursorSwapNext 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 -> SwapResult (TreeCursor a b)
forall a. SwapResult a
SwapperIsTopNode
    Just TreeAbove b
ta ->
      case TreeAbove b -> [CTree b]
forall b. TreeAbove b -> [CTree b]
treeAboveRights TreeAbove b
ta of
        [] -> SwapResult (TreeCursor a b)
forall a. SwapResult a
NoSiblingsToSwapWith
        (CTree b
t : [CTree b]
ts) ->
          TreeCursor a b -> SwapResult (TreeCursor a b)
forall a. a -> SwapResult a
Swapped (TreeCursor a b -> SwapResult (TreeCursor a b))
-> TreeCursor a b -> SwapResult (TreeCursor a b)
forall a b. (a -> b) -> a -> b
$
            TreeCursor a b
tc {treeAbove :: Maybe (TreeAbove b)
treeAbove = TreeAbove b -> Maybe (TreeAbove b)
forall a. a -> Maybe a
Just TreeAbove b
ta {treeAboveLefts :: [CTree b]
treeAboveLefts = CTree b
t CTree b -> [CTree b] -> [CTree b]
forall a. a -> [a] -> [a]
: TreeAbove b -> [CTree b]
forall b. TreeAbove b -> [CTree b]
treeAboveLefts TreeAbove b
ta, treeAboveRights :: [CTree b]
treeAboveRights = [CTree b]
ts}}

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

instance Validity a => Validity (SwapResult a)

instance NFData a => NFData (SwapResult a)