{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}

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

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

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

   Interface definition for trees

   n-ary tree structure (rose trees)

-}

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

module Data.Tree.NTree.TypeDefs
where

import           Control.DeepSeq     (NFData (..))
import           Control.FlatSeq     (WNFData (..), rlnf)

import           Data.Binary
import           Data.Tree.Class     (Tree (..))
import           Data.Typeable       (Typeable)

#if MIN_VERSION_base(4,13,0)
#else
import           Data.Monoid         ((<>))
#endif

#if MIN_VERSION_base(4,8,2)
#else
import           Control.Applicative ((<$>))
#endif

#if MIN_VERSION_base(4,8,0)
#else
import           Control.Applicative (Applicative (..))
import           Data.Foldable       (Foldable (..))
import           Data.Monoid         (Monoid (..))
import           Data.Traversable    (Traversable (..), sequenceA)
#endif

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

-- | n-ary ordered tree (rose trees)
--
-- a tree consists of a node and a possible empty list of children.
-- If the list of children is empty, the node is a leaf, else it's
-- an inner node.
--
-- NTree implements Eq, Ord, Show and Read

data NTree  a   = NTree a (NTrees a)
    deriving
    (NTree a -> NTree a -> Bool
(NTree a -> NTree a -> Bool)
-> (NTree a -> NTree a -> Bool) -> Eq (NTree a)
forall a. Eq a => NTree a -> NTree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NTree a -> NTree a -> Bool
$c/= :: forall a. Eq a => NTree a -> NTree a -> Bool
== :: NTree a -> NTree a -> Bool
$c== :: forall a. Eq a => NTree a -> NTree a -> Bool
Eq, Eq (NTree a)
Eq (NTree a)
-> (NTree a -> NTree a -> Ordering)
-> (NTree a -> NTree a -> Bool)
-> (NTree a -> NTree a -> Bool)
-> (NTree a -> NTree a -> Bool)
-> (NTree a -> NTree a -> Bool)
-> (NTree a -> NTree a -> NTree a)
-> (NTree a -> NTree a -> NTree a)
-> Ord (NTree a)
NTree a -> NTree a -> Bool
NTree a -> NTree a -> Ordering
NTree a -> NTree a -> NTree a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (NTree a)
forall a. Ord a => NTree a -> NTree a -> Bool
forall a. Ord a => NTree a -> NTree a -> Ordering
forall a. Ord a => NTree a -> NTree a -> NTree a
min :: NTree a -> NTree a -> NTree a
$cmin :: forall a. Ord a => NTree a -> NTree a -> NTree a
max :: NTree a -> NTree a -> NTree a
$cmax :: forall a. Ord a => NTree a -> NTree a -> NTree a
>= :: NTree a -> NTree a -> Bool
$c>= :: forall a. Ord a => NTree a -> NTree a -> Bool
> :: NTree a -> NTree a -> Bool
$c> :: forall a. Ord a => NTree a -> NTree a -> Bool
<= :: NTree a -> NTree a -> Bool
$c<= :: forall a. Ord a => NTree a -> NTree a -> Bool
< :: NTree a -> NTree a -> Bool
$c< :: forall a. Ord a => NTree a -> NTree a -> Bool
compare :: NTree a -> NTree a -> Ordering
$ccompare :: forall a. Ord a => NTree a -> NTree a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (NTree a)
Ord, Int -> NTree a -> ShowS
[NTree a] -> ShowS
NTree a -> String
(Int -> NTree a -> ShowS)
-> (NTree a -> String) -> ([NTree a] -> ShowS) -> Show (NTree a)
forall a. Show a => Int -> NTree a -> ShowS
forall a. Show a => [NTree a] -> ShowS
forall a. Show a => NTree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NTree a] -> ShowS
$cshowList :: forall a. Show a => [NTree a] -> ShowS
show :: NTree a -> String
$cshow :: forall a. Show a => NTree a -> String
showsPrec :: Int -> NTree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> NTree a -> ShowS
Show, ReadPrec [NTree a]
ReadPrec (NTree a)
Int -> ReadS (NTree a)
ReadS [NTree a]
(Int -> ReadS (NTree a))
-> ReadS [NTree a]
-> ReadPrec (NTree a)
-> ReadPrec [NTree a]
-> Read (NTree a)
forall a. Read a => ReadPrec [NTree a]
forall a. Read a => ReadPrec (NTree a)
forall a. Read a => Int -> ReadS (NTree a)
forall a. Read a => ReadS [NTree a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NTree a]
$creadListPrec :: forall a. Read a => ReadPrec [NTree a]
readPrec :: ReadPrec (NTree a)
$creadPrec :: forall a. Read a => ReadPrec (NTree a)
readList :: ReadS [NTree a]
$creadList :: forall a. Read a => ReadS [NTree a]
readsPrec :: Int -> ReadS (NTree a)
$creadsPrec :: forall a. Read a => Int -> ReadS (NTree a)
Read, Typeable)

-- | shortcut for a sequence of n-ary trees

type NTrees   a = [NTree a]

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

instance (NFData a) => NFData (NTree a) where
    rnf :: NTree a -> ()
rnf (NTree a
n NTrees a
cl)                    = a -> ()
forall a. NFData a => a -> ()
rnf a
n () -> () -> ()
`seq` NTrees a -> ()
forall a. NFData a => a -> ()
rnf NTrees a
cl
    {-# INLINE rnf #-}

instance (WNFData a) => WNFData (NTree a) where
    rwnf :: NTree a -> ()
rwnf (NTree a
n NTrees a
cl)                   = a -> ()
forall a. WNFData a => a -> ()
rwnf a
n () -> () -> ()
`seq` NTrees a -> ()
forall a. WNFData a => a -> ()
rwnf NTrees a
cl
    {-# INLINE rwnf #-}

    -- | Evaluate a tree 2 steps deep, the top node and all children are evaluated with rwnf
    rwnf2 :: NTree a -> ()
rwnf2 (NTree a
n NTrees a
cl)                  = a -> ()
forall a. WNFData a => a -> ()
rwnf a
n () -> () -> ()
`seq` (NTree a -> ()) -> NTrees a -> ()
forall a. (a -> ()) -> [a] -> ()
rlnf NTree a -> ()
forall a. WNFData a => a -> ()
rwnf NTrees a
cl
    {-# INLINE rwnf2 #-}

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

instance (Binary a) => Binary (NTree a) where
    put :: NTree a -> Put
put (NTree a
n [NTree a]
cs)    = a -> Put
forall t. Binary t => t -> Put
put a
n Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [NTree a] -> Put
forall t. Binary t => t -> Put
put [NTree a]
cs
    get :: Get (NTree a)
get                 = do
                          a
n  <- Get a
forall t. Binary t => Get t
get
                          [NTree a]
cs <- Get [NTree a]
forall t. Binary t => Get t
get
                          NTree a -> Get (NTree a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> [NTree a] -> NTree a
forall a. a -> NTrees a -> NTree a
NTree a
n [NTree a]
cs)

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

-- | NTree implements class Functor

instance Functor NTree where
    fmap :: (a -> b) -> NTree a -> NTree b
fmap a -> b
f (NTree a
n NTrees a
cl)                 = b -> NTrees b -> NTree b
forall a. a -> NTrees a -> NTree a
NTree (a -> b
f a
n) ((NTree a -> NTree b) -> NTrees a -> NTrees b
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> NTree a -> NTree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) NTrees a
cl)
    {-# INLINE fmap #-}

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

-- | NTree implements class Foldable

instance Foldable NTree where
    foldMap :: (a -> m) -> NTree a -> m
foldMap a -> m
f (NTree a
n NTrees a
cl)              = a -> m
f a
n m -> m -> m
forall a. Semigroup a => a -> a -> a
<> [m] -> m
forall a. Monoid a => [a] -> a
mconcat ((NTree a -> m) -> NTrees a -> [m]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> m) -> NTree a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) NTrees a
cl)
    {-# INLINE foldMap #-}


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

-- | NTree implements class Taversable

instance Traversable NTree where
    traverse :: (a -> f b) -> NTree a -> f (NTree b)
traverse a -> f b
f (NTree a
n NTrees a
cl)             = b -> NTrees b -> NTree b
forall a. a -> NTrees a -> NTree a
NTree (b -> NTrees b -> NTree b) -> f b -> f (NTrees b -> NTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
n f (NTrees b -> NTree b) -> f (NTrees b) -> f (NTree b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [f (NTree b)] -> f (NTrees b)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ((NTree a -> f (NTree b)) -> NTrees a -> [f (NTree b)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> f b) -> NTree a -> f (NTree b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f) NTrees a
cl)
    {-# INLINE traverse #-}

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

-- | Implementation of "Data.Tree.Class" interface for rose trees

instance Tree NTree where
    mkTree :: a -> [NTree a] -> NTree a
mkTree a
n [NTree a]
cl                         = a -> [NTree a] -> NTree a
forall a. a -> NTrees a -> NTree a
NTree a
n [NTree a]
cl
    {-# INLINE mkTree #-}

    getNode :: NTree a -> a
getNode           ~(NTree a
n NTrees a
_ )     = a
n
    {-# INLINE getNode #-}
    getChildren :: NTree a -> [NTree a]
getChildren       ~(NTree a
_ [NTree a]
cl)     = [NTree a]
cl
    {-# INLINE getChildren #-}

    changeNode :: (a -> a) -> NTree a -> NTree a
changeNode     a -> a
cf ~(NTree a
n NTrees a
cl)     = a -> NTrees a -> NTree a
forall a. a -> NTrees a -> NTree a
NTree (a -> a
cf a
n) NTrees a
cl
    {-# INLINE changeNode #-}
    changeChildren :: ([NTree a] -> [NTree a]) -> NTree a -> NTree a
changeChildren [NTree a] -> [NTree a]
cf ~(NTree a
n [NTree a]
cl)     = a -> [NTree a] -> NTree a
forall a. a -> NTrees a -> NTree a
NTree a
n ([NTree a] -> [NTree a]
cf [NTree a]
cl)
    {-# INLINE changeChildren #-}

    foldTree :: (a -> [b] -> b) -> NTree a -> b
foldTree        a -> [b] -> b
f ~(NTree a
n NTrees a
cs)     = a -> [b] -> b
f a
n ((NTree a -> b) -> NTrees a -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> [b] -> b) -> NTree a -> b
forall (t :: * -> *) a b. Tree t => (a -> [b] -> b) -> t a -> b
foldTree a -> [b] -> b
f) NTrees a
cs)
    {-# INLINE foldTree #-}

-- eof ------------------------------------------------------------