{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE TypeFamilies               #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Tree.DUAL.Internal
-- Copyright   :  (c) 2011-2012 Brent Yorgey
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- This module provides access to all of the internals of the
-- DUAL-tree implementation.  Depend on the internals at your own
-- risk!  For a safe public API (and complete documentation), see
-- "Data.Tree.DUAL".
--
-- The main things exported by this module which are not exported from
-- "Data.Tree.DUAL" are two extra types used in the implementation of
-- 'DUALTree', along with functions for manipulating them.  A type of
-- /non-empty/ trees, 'DUALTreeNE', is defined, as well as the type
-- 'DUALTreeU' which represents a non-empty tree paired with a cached
-- @u@ annotation.  'DUALTreeNE' and 'DUALTreeU' are mutually
-- recursive, so that recursive tree nodes are interleaved with cached
-- @u@ annotations.  'DUALTree' is defined by just wrapping
-- 'DUALTreeU' in 'Maybe.  This method has the advantage that the
-- type system enforces the invariant that there is only one
-- representation for the empty tree.  It also allows us to get away
-- with only 'Semigroup' constraints in many places.
--
-----------------------------------------------------------------------------

module Data.Tree.DUAL.Internal
       (
         -- * DUAL-trees
         DUALTreeNE(..), DUALTreeU(..), DUALTree(..)

         -- * Constructing DUAL-trees
       , empty, leaf, leafU, annot, applyD

         -- * Modifying DUAL-trees
       , applyUpre, applyUpost
       , mapUNE, mapUU, mapU

         -- * Accessors and eliminators
       , nonEmpty, getU, foldDUALNE, foldDUAL, flatten

       ) where

import           Control.Arrow      ((***))
import           Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NEL
import           Data.Maybe         (fromMaybe)
import           Data.Monoid.Action
import           Data.Semigroup
import           Data.Typeable

import           Control.Newtype.Generics

------------------------------------------------------------
-- DUALTreeNE
------------------------------------------------------------

-- | /Non-empty/ DUAL-trees.
data DUALTreeNE d u a l
  = Leaf   u l        -- ^ Leaf with data value and @u@ annotation
  | LeafU  u          -- ^ Leaf with only @u@ annotation
  | Concat (NonEmpty (DUALTreeU d u a l))
                      -- ^ n-way branch, containing a /non-empty/ list
                      --   of subtrees.
  | Act    d (DUALTreeU d u a l)
                      -- ^ @d@ annotation
  | Annot  a (DUALTreeU d u a l)
                      -- ^ Internal data value
  deriving (a -> DUALTreeNE d u a b -> DUALTreeNE d u a a
(a -> b) -> DUALTreeNE d u a a -> DUALTreeNE d u a b
(forall a b. (a -> b) -> DUALTreeNE d u a a -> DUALTreeNE d u a b)
-> (forall a b. a -> DUALTreeNE d u a b -> DUALTreeNE d u a a)
-> Functor (DUALTreeNE d u a)
forall a b. a -> DUALTreeNE d u a b -> DUALTreeNE d u a a
forall a b. (a -> b) -> DUALTreeNE d u a a -> DUALTreeNE d u a b
forall d u a a b. a -> DUALTreeNE d u a b -> DUALTreeNE d u a a
forall d u a a b.
(a -> b) -> DUALTreeNE d u a a -> DUALTreeNE d u a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> DUALTreeNE d u a b -> DUALTreeNE d u a a
$c<$ :: forall d u a a b. a -> DUALTreeNE d u a b -> DUALTreeNE d u a a
fmap :: (a -> b) -> DUALTreeNE d u a a -> DUALTreeNE d u a b
$cfmap :: forall d u a a b.
(a -> b) -> DUALTreeNE d u a a -> DUALTreeNE d u a b
Functor, Typeable, Int -> DUALTreeNE d u a l -> ShowS
[DUALTreeNE d u a l] -> ShowS
DUALTreeNE d u a l -> String
(Int -> DUALTreeNE d u a l -> ShowS)
-> (DUALTreeNE d u a l -> String)
-> ([DUALTreeNE d u a l] -> ShowS)
-> Show (DUALTreeNE d u a l)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall d u a l.
(Show u, Show l, Show d, Show a) =>
Int -> DUALTreeNE d u a l -> ShowS
forall d u a l.
(Show u, Show l, Show d, Show a) =>
[DUALTreeNE d u a l] -> ShowS
forall d u a l.
(Show u, Show l, Show d, Show a) =>
DUALTreeNE d u a l -> String
showList :: [DUALTreeNE d u a l] -> ShowS
$cshowList :: forall d u a l.
(Show u, Show l, Show d, Show a) =>
[DUALTreeNE d u a l] -> ShowS
show :: DUALTreeNE d u a l -> String
$cshow :: forall d u a l.
(Show u, Show l, Show d, Show a) =>
DUALTreeNE d u a l -> String
showsPrec :: Int -> DUALTreeNE d u a l -> ShowS
$cshowsPrec :: forall d u a l.
(Show u, Show l, Show d, Show a) =>
Int -> DUALTreeNE d u a l -> ShowS
Show, DUALTreeNE d u a l -> DUALTreeNE d u a l -> Bool
(DUALTreeNE d u a l -> DUALTreeNE d u a l -> Bool)
-> (DUALTreeNE d u a l -> DUALTreeNE d u a l -> Bool)
-> Eq (DUALTreeNE d u a l)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall d u a l.
(Eq u, Eq l, Eq d, Eq a) =>
DUALTreeNE d u a l -> DUALTreeNE d u a l -> Bool
/= :: DUALTreeNE d u a l -> DUALTreeNE d u a l -> Bool
$c/= :: forall d u a l.
(Eq u, Eq l, Eq d, Eq a) =>
DUALTreeNE d u a l -> DUALTreeNE d u a l -> Bool
== :: DUALTreeNE d u a l -> DUALTreeNE d u a l -> Bool
$c== :: forall d u a l.
(Eq u, Eq l, Eq d, Eq a) =>
DUALTreeNE d u a l -> DUALTreeNE d u a l -> Bool
Eq)

instance (Action d u, Semigroup u) => Semigroup (DUALTreeNE d u a l) where
  DUALTreeNE d u a l
t1 <> :: DUALTreeNE d u a l -> DUALTreeNE d u a l -> DUALTreeNE d u a l
<> DUALTreeNE d u a l
t2   = NonEmpty (DUALTreeNE d u a l) -> DUALTreeNE d u a l
forall a. Semigroup a => NonEmpty a -> a
sconcat ([DUALTreeNE d u a l] -> NonEmpty (DUALTreeNE d u a l)
forall a. [a] -> NonEmpty a
NEL.fromList [DUALTreeNE d u a l
t1,DUALTreeNE d u a l
t2])
  sconcat :: NonEmpty (DUALTreeNE d u a l) -> DUALTreeNE d u a l
sconcat    = NonEmpty (DUALTreeU d u a l) -> DUALTreeNE d u a l
forall d u a l. NonEmpty (DUALTreeU d u a l) -> DUALTreeNE d u a l
Concat (NonEmpty (DUALTreeU d u a l) -> DUALTreeNE d u a l)
-> (NonEmpty (DUALTreeNE d u a l) -> NonEmpty (DUALTreeU d u a l))
-> NonEmpty (DUALTreeNE d u a l)
-> DUALTreeNE d u a l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DUALTreeNE d u a l -> DUALTreeU d u a l)
-> NonEmpty (DUALTreeNE d u a l) -> NonEmpty (DUALTreeU d u a l)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NEL.map DUALTreeNE d u a l -> DUALTreeU d u a l
forall u d a l.
(Semigroup u, Action d u) =>
DUALTreeNE d u a l -> DUALTreeU d u a l
pullU

newtype DAct d = DAct { DAct d -> d
unDAct :: d }

instance Newtype (DAct d) where
  type O (DAct d) = d
  pack :: O (DAct d) -> DAct d
pack   = O (DAct d) -> DAct d
forall d. d -> DAct d
DAct
  unpack :: DAct d -> O (DAct d)
unpack = DAct d -> O (DAct d)
forall d. DAct d -> d
unDAct

instance (Semigroup d, Semigroup u, Action d u)
    => Action (DAct d) (DUALTreeNE d u a l) where
  act :: DAct d -> DUALTreeNE d u a l -> DUALTreeNE d u a l
act (DAct d
d) (Act d
d' DUALTreeU d u a l
t) = d -> DUALTreeU d u a l -> DUALTreeNE d u a l
forall d u a l. d -> DUALTreeU d u a l -> DUALTreeNE d u a l
Act (d
d d -> d -> d
forall a. Semigroup a => a -> a -> a
<> d
d') DUALTreeU d u a l
t
  act (DAct d
d) DUALTreeNE d u a l
t          = d -> DUALTreeU d u a l -> DUALTreeNE d u a l
forall d u a l. d -> DUALTreeU d u a l -> DUALTreeNE d u a l
Act d
d (DUALTreeNE d u a l -> DUALTreeU d u a l
forall u d a l.
(Semigroup u, Action d u) =>
DUALTreeNE d u a l -> DUALTreeU d u a l
pullU DUALTreeNE d u a l
t)

------------------------------------------------------------
-- DUALTreeU
------------------------------------------------------------

-- | A non-empty DUAL-tree paired with a cached @u@ value.  These
--   should never be constructed directly; instead, use 'pullU'.
newtype DUALTreeU d u a l = DUALTreeU { DUALTreeU d u a l -> (u, DUALTreeNE d u a l)
unDUALTreeU :: (u, DUALTreeNE d u a l) }
  deriving (a -> DUALTreeU d u a b -> DUALTreeU d u a a
(a -> b) -> DUALTreeU d u a a -> DUALTreeU d u a b
(forall a b. (a -> b) -> DUALTreeU d u a a -> DUALTreeU d u a b)
-> (forall a b. a -> DUALTreeU d u a b -> DUALTreeU d u a a)
-> Functor (DUALTreeU d u a)
forall a b. a -> DUALTreeU d u a b -> DUALTreeU d u a a
forall a b. (a -> b) -> DUALTreeU d u a a -> DUALTreeU d u a b
forall d u a a b. a -> DUALTreeU d u a b -> DUALTreeU d u a a
forall d u a a b.
(a -> b) -> DUALTreeU d u a a -> DUALTreeU d u a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> DUALTreeU d u a b -> DUALTreeU d u a a
$c<$ :: forall d u a a b. a -> DUALTreeU d u a b -> DUALTreeU d u a a
fmap :: (a -> b) -> DUALTreeU d u a a -> DUALTreeU d u a b
$cfmap :: forall d u a a b.
(a -> b) -> DUALTreeU d u a a -> DUALTreeU d u a b
Functor, b -> DUALTreeU d u a l -> DUALTreeU d u a l
NonEmpty (DUALTreeU d u a l) -> DUALTreeU d u a l
DUALTreeU d u a l -> DUALTreeU d u a l -> DUALTreeU d u a l
(DUALTreeU d u a l -> DUALTreeU d u a l -> DUALTreeU d u a l)
-> (NonEmpty (DUALTreeU d u a l) -> DUALTreeU d u a l)
-> (forall b.
    Integral b =>
    b -> DUALTreeU d u a l -> DUALTreeU d u a l)
-> Semigroup (DUALTreeU d u a l)
forall b. Integral b => b -> DUALTreeU d u a l -> DUALTreeU d u a l
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall d u a l.
(Semigroup u, Action d u) =>
NonEmpty (DUALTreeU d u a l) -> DUALTreeU d u a l
forall d u a l.
(Semigroup u, Action d u) =>
DUALTreeU d u a l -> DUALTreeU d u a l -> DUALTreeU d u a l
forall d u a l b.
(Semigroup u, Action d u, Integral b) =>
b -> DUALTreeU d u a l -> DUALTreeU d u a l
stimes :: b -> DUALTreeU d u a l -> DUALTreeU d u a l
$cstimes :: forall d u a l b.
(Semigroup u, Action d u, Integral b) =>
b -> DUALTreeU d u a l -> DUALTreeU d u a l
sconcat :: NonEmpty (DUALTreeU d u a l) -> DUALTreeU d u a l
$csconcat :: forall d u a l.
(Semigroup u, Action d u) =>
NonEmpty (DUALTreeU d u a l) -> DUALTreeU d u a l
<> :: DUALTreeU d u a l -> DUALTreeU d u a l -> DUALTreeU d u a l
$c<> :: forall d u a l.
(Semigroup u, Action d u) =>
DUALTreeU d u a l -> DUALTreeU d u a l -> DUALTreeU d u a l
Semigroup, Typeable, Int -> DUALTreeU d u a l -> ShowS
[DUALTreeU d u a l] -> ShowS
DUALTreeU d u a l -> String
(Int -> DUALTreeU d u a l -> ShowS)
-> (DUALTreeU d u a l -> String)
-> ([DUALTreeU d u a l] -> ShowS)
-> Show (DUALTreeU d u a l)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall d u a l.
(Show u, Show l, Show d, Show a) =>
Int -> DUALTreeU d u a l -> ShowS
forall d u a l.
(Show u, Show l, Show d, Show a) =>
[DUALTreeU d u a l] -> ShowS
forall d u a l.
(Show u, Show l, Show d, Show a) =>
DUALTreeU d u a l -> String
showList :: [DUALTreeU d u a l] -> ShowS
$cshowList :: forall d u a l.
(Show u, Show l, Show d, Show a) =>
[DUALTreeU d u a l] -> ShowS
show :: DUALTreeU d u a l -> String
$cshow :: forall d u a l.
(Show u, Show l, Show d, Show a) =>
DUALTreeU d u a l -> String
showsPrec :: Int -> DUALTreeU d u a l -> ShowS
$cshowsPrec :: forall d u a l.
(Show u, Show l, Show d, Show a) =>
Int -> DUALTreeU d u a l -> ShowS
Show, DUALTreeU d u a l -> DUALTreeU d u a l -> Bool
(DUALTreeU d u a l -> DUALTreeU d u a l -> Bool)
-> (DUALTreeU d u a l -> DUALTreeU d u a l -> Bool)
-> Eq (DUALTreeU d u a l)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall d u a l.
(Eq u, Eq l, Eq d, Eq a) =>
DUALTreeU d u a l -> DUALTreeU d u a l -> Bool
/= :: DUALTreeU d u a l -> DUALTreeU d u a l -> Bool
$c/= :: forall d u a l.
(Eq u, Eq l, Eq d, Eq a) =>
DUALTreeU d u a l -> DUALTreeU d u a l -> Bool
== :: DUALTreeU d u a l -> DUALTreeU d u a l -> Bool
$c== :: forall d u a l.
(Eq u, Eq l, Eq d, Eq a) =>
DUALTreeU d u a l -> DUALTreeU d u a l -> Bool
Eq)

instance Newtype (DUALTreeU d u a l) where
  type O (DUALTreeU d u a l) = (u, DUALTreeNE d u a l)
  pack :: O (DUALTreeU d u a l) -> DUALTreeU d u a l
pack   = O (DUALTreeU d u a l) -> DUALTreeU d u a l
forall d u a l. (u, DUALTreeNE d u a l) -> DUALTreeU d u a l
DUALTreeU
  unpack :: DUALTreeU d u a l -> O (DUALTreeU d u a l)
unpack = DUALTreeU d u a l -> O (DUALTreeU d u a l)
forall d u a l. DUALTreeU d u a l -> (u, DUALTreeNE d u a l)
unDUALTreeU

instance (Semigroup d, Semigroup u, Action d u)
    => Action (DAct d) (DUALTreeU d u a l) where
  act :: DAct d -> DUALTreeU d u a l -> DUALTreeU d u a l
act DAct d
d = ((u, DUALTreeNE d u a l) -> DUALTreeU d u a l)
-> ((u, DUALTreeNE d u a l) -> (u, DUALTreeNE d u a l))
-> DUALTreeU d u a l
-> DUALTreeU d u a l
forall n n' o' o.
(Newtype n, Newtype n', o' ~ O n', o ~ O n) =>
(o -> n) -> (o -> o') -> n -> n'
over (u, DUALTreeNE d u a l) -> DUALTreeU d u a l
forall d u a l. (u, DUALTreeNE d u a l) -> DUALTreeU d u a l
DUALTreeU (d -> u -> u
forall m s. Action m s => m -> s -> s
act (DAct d -> d
forall d. DAct d -> d
unDAct DAct d
d) (u -> u)
-> (DUALTreeNE d u a l -> DUALTreeNE d u a l)
-> (u, DUALTreeNE d u a l)
-> (u, DUALTreeNE d u a l)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** DAct d -> DUALTreeNE d u a l -> DUALTreeNE d u a l
forall m s. Action m s => m -> s -> s
act DAct d
d)

-- | \"Pull\" the root @u@ annotation out into a tuple.
pullU :: (Semigroup u, Action d u) => DUALTreeNE d u a l -> DUALTreeU d u a l
pullU :: DUALTreeNE d u a l -> DUALTreeU d u a l
pullU t :: DUALTreeNE d u a l
t@(Leaf u
u l
_)                   = O (DUALTreeU d u a l) -> DUALTreeU d u a l
forall n. Newtype n => O n -> n
pack (u
u, DUALTreeNE d u a l
t)
pullU t :: DUALTreeNE d u a l
t@(LeafU u
u)                    = O (DUALTreeU d u a l) -> DUALTreeU d u a l
forall n. Newtype n => O n -> n
pack (u
u, DUALTreeNE d u a l
t)
pullU t :: DUALTreeNE d u a l
t@(Concat NonEmpty (DUALTreeU d u a l)
ts)                  = O (DUALTreeU d u a l) -> DUALTreeU d u a l
forall n. Newtype n => O n -> n
pack (NonEmpty u -> u
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty u -> u)
-> (NonEmpty (DUALTreeU d u a l) -> NonEmpty u)
-> NonEmpty (DUALTreeU d u a l)
-> u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DUALTreeU d u a l -> u)
-> NonEmpty (DUALTreeU d u a l) -> NonEmpty u
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NEL.map ((u, DUALTreeNE d u a l) -> u
forall a b. (a, b) -> a
fst ((u, DUALTreeNE d u a l) -> u)
-> (DUALTreeU d u a l -> (u, DUALTreeNE d u a l))
-> DUALTreeU d u a l
-> u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DUALTreeU d u a l -> (u, DUALTreeNE d u a l)
forall n. Newtype n => n -> O n
unpack) (NonEmpty (DUALTreeU d u a l) -> u)
-> NonEmpty (DUALTreeU d u a l) -> u
forall a b. (a -> b) -> a -> b
$ NonEmpty (DUALTreeU d u a l)
ts, DUALTreeNE d u a l
t)
pullU t :: DUALTreeNE d u a l
t@(Act d
d (DUALTreeU (u
u,DUALTreeNE d u a l
_)))    = O (DUALTreeU d u a l) -> DUALTreeU d u a l
forall n. Newtype n => O n -> n
pack (d -> u -> u
forall m s. Action m s => m -> s -> s
act d
d u
u, DUALTreeNE d u a l
t)
pullU t :: DUALTreeNE d u a l
t@(Annot a
_ (DUALTreeU (u
u, DUALTreeNE d u a l
_))) = O (DUALTreeU d u a l) -> DUALTreeU d u a l
forall n. Newtype n => O n -> n
pack (u
u, DUALTreeNE d u a l
t)

------------------------------------------------------------
-- DUALTree
------------------------------------------------------------

-- | Rose (n-ary) trees with both upwards- (/i.e./ cached) and
--   downwards-traveling (/i.e./ accumulating) monoidal annotations.
--   Abstractly, a DUALTree is a rose (n-ary) tree with data (of type
--   @l@) at leaves, data (of type @a@) at internal nodes, and two
--   types of monoidal annotations, one (of type @u@) travelling
--   \"up\" the tree and one (of type @d@) traveling \"down\".  See
--   the documentation at the top of this file for full details.
--
--   @DUALTree@ comes with some instances:
--
--   * 'Functor', for modifying leaf data.  Note that 'fmap' of course
--     cannot alter any @u@ annotations.
--
--   * 'Semigroup'. @DUALTreeNE@s form a semigroup where @(\<\>)@
--     corresponds to adjoining two trees under a common parent root,
--     with @sconcat@ specialized to put all the trees under a single
--     parent.  Note that this does not satisfy associativity up to
--     structural equality, but only up to observational equivalence
--     under 'flatten'.  Technically using 'foldDUAL' directly enables
--     one to observe the difference, but it is understood that
--     'foldDUAL' should be used only in ways such that reassociation
--     of subtrees \"does not matter\".
--
--   * 'Monoid'. The identity is the empty tree.

newtype DUALTree d u a l = DUALTree { DUALTree d u a l -> Maybe (DUALTreeU d u a l)
unDUALTree :: Maybe (DUALTreeU d u a l) }
  deriving ( a -> DUALTree d u a b -> DUALTree d u a a
(a -> b) -> DUALTree d u a a -> DUALTree d u a b
(forall a b. (a -> b) -> DUALTree d u a a -> DUALTree d u a b)
-> (forall a b. a -> DUALTree d u a b -> DUALTree d u a a)
-> Functor (DUALTree d u a)
forall a b. a -> DUALTree d u a b -> DUALTree d u a a
forall a b. (a -> b) -> DUALTree d u a a -> DUALTree d u a b
forall d u a a b. a -> DUALTree d u a b -> DUALTree d u a a
forall d u a a b. (a -> b) -> DUALTree d u a a -> DUALTree d u a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> DUALTree d u a b -> DUALTree d u a a
$c<$ :: forall d u a a b. a -> DUALTree d u a b -> DUALTree d u a a
fmap :: (a -> b) -> DUALTree d u a a -> DUALTree d u a b
$cfmap :: forall d u a a b. (a -> b) -> DUALTree d u a a -> DUALTree d u a b
Functor, b -> DUALTree d u a l -> DUALTree d u a l
NonEmpty (DUALTree d u a l) -> DUALTree d u a l
DUALTree d u a l -> DUALTree d u a l -> DUALTree d u a l
(DUALTree d u a l -> DUALTree d u a l -> DUALTree d u a l)
-> (NonEmpty (DUALTree d u a l) -> DUALTree d u a l)
-> (forall b.
    Integral b =>
    b -> DUALTree d u a l -> DUALTree d u a l)
-> Semigroup (DUALTree d u a l)
forall b. Integral b => b -> DUALTree d u a l -> DUALTree d u a l
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall d u a l.
(Semigroup u, Action d u) =>
NonEmpty (DUALTree d u a l) -> DUALTree d u a l
forall d u a l.
(Semigroup u, Action d u) =>
DUALTree d u a l -> DUALTree d u a l -> DUALTree d u a l
forall d u a l b.
(Semigroup u, Action d u, Integral b) =>
b -> DUALTree d u a l -> DUALTree d u a l
stimes :: b -> DUALTree d u a l -> DUALTree d u a l
$cstimes :: forall d u a l b.
(Semigroup u, Action d u, Integral b) =>
b -> DUALTree d u a l -> DUALTree d u a l
sconcat :: NonEmpty (DUALTree d u a l) -> DUALTree d u a l
$csconcat :: forall d u a l.
(Semigroup u, Action d u) =>
NonEmpty (DUALTree d u a l) -> DUALTree d u a l
<> :: DUALTree d u a l -> DUALTree d u a l -> DUALTree d u a l
$c<> :: forall d u a l.
(Semigroup u, Action d u) =>
DUALTree d u a l -> DUALTree d u a l -> DUALTree d u a l
Semigroup, Typeable, Int -> DUALTree d u a l -> ShowS
[DUALTree d u a l] -> ShowS
DUALTree d u a l -> String
(Int -> DUALTree d u a l -> ShowS)
-> (DUALTree d u a l -> String)
-> ([DUALTree d u a l] -> ShowS)
-> Show (DUALTree d u a l)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall d u a l.
(Show u, Show l, Show d, Show a) =>
Int -> DUALTree d u a l -> ShowS
forall d u a l.
(Show u, Show l, Show d, Show a) =>
[DUALTree d u a l] -> ShowS
forall d u a l.
(Show u, Show l, Show d, Show a) =>
DUALTree d u a l -> String
showList :: [DUALTree d u a l] -> ShowS
$cshowList :: forall d u a l.
(Show u, Show l, Show d, Show a) =>
[DUALTree d u a l] -> ShowS
show :: DUALTree d u a l -> String
$cshow :: forall d u a l.
(Show u, Show l, Show d, Show a) =>
DUALTree d u a l -> String
showsPrec :: Int -> DUALTree d u a l -> ShowS
$cshowsPrec :: forall d u a l.
(Show u, Show l, Show d, Show a) =>
Int -> DUALTree d u a l -> ShowS
Show, DUALTree d u a l -> DUALTree d u a l -> Bool
(DUALTree d u a l -> DUALTree d u a l -> Bool)
-> (DUALTree d u a l -> DUALTree d u a l -> Bool)
-> Eq (DUALTree d u a l)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall d u a l.
(Eq u, Eq l, Eq d, Eq a) =>
DUALTree d u a l -> DUALTree d u a l -> Bool
/= :: DUALTree d u a l -> DUALTree d u a l -> Bool
$c/= :: forall d u a l.
(Eq u, Eq l, Eq d, Eq a) =>
DUALTree d u a l -> DUALTree d u a l -> Bool
== :: DUALTree d u a l -> DUALTree d u a l -> Bool
$c== :: forall d u a l.
(Eq u, Eq l, Eq d, Eq a) =>
DUALTree d u a l -> DUALTree d u a l -> Bool
Eq )

instance Newtype (DUALTree d u a l) where
  type O (DUALTree d u a l) = Maybe (DUALTreeU d u a l)
  pack :: O (DUALTree d u a l) -> DUALTree d u a l
pack   = O (DUALTree d u a l) -> DUALTree d u a l
forall d u a l. Maybe (DUALTreeU d u a l) -> DUALTree d u a l
DUALTree
  unpack :: DUALTree d u a l -> O (DUALTree d u a l)
unpack = DUALTree d u a l -> O (DUALTree d u a l)
forall d u a l. DUALTree d u a l -> Maybe (DUALTreeU d u a l)
unDUALTree

instance (Semigroup u, Action d u) => Monoid (DUALTree d u a l) where
  mempty :: DUALTree d u a l
mempty  = Maybe (DUALTreeU d u a l) -> DUALTree d u a l
forall d u a l. Maybe (DUALTreeU d u a l) -> DUALTree d u a l
DUALTree Maybe (DUALTreeU d u a l)
forall a. Monoid a => a
mempty
  mappend :: DUALTree d u a l -> DUALTree d u a l -> DUALTree d u a l
mappend = DUALTree d u a l -> DUALTree d u a l -> DUALTree d u a l
forall a. Semigroup a => a -> a -> a
(<>)
  mconcat :: [DUALTree d u a l] -> DUALTree d u a l
mconcat []     = DUALTree d u a l
forall a. Monoid a => a
mempty
  mconcat (DUALTree d u a l
x:[DUALTree d u a l]
xs) = NonEmpty (DUALTree d u a l) -> DUALTree d u a l
forall a. Semigroup a => NonEmpty a -> a
sconcat (DUALTree d u a l
x DUALTree d u a l
-> [DUALTree d u a l] -> NonEmpty (DUALTree d u a l)
forall a. a -> [a] -> NonEmpty a
:| [DUALTree d u a l]
xs)

-- | Apply a @d@ annotation at the root of a tree.  Semantically, all
--   @u@ annotations are transformed by the action of @d@, although
--   operationally @act@ incurs only a constant amount of work.
instance (Semigroup d, Semigroup u, Action d u)
    => Action (DAct d) (DUALTree d u a l) where
  act :: DAct d -> DUALTree d u a l -> DUALTree d u a l
act = (Maybe (DUALTreeU d u a l) -> DUALTree d u a l)
-> (Maybe (DUALTreeU d u a l) -> Maybe (DUALTreeU d u a l))
-> DUALTree d u a l
-> DUALTree d u a l
forall n n' o' o.
(Newtype n, Newtype n', o' ~ O n', o ~ O n) =>
(o -> n) -> (o -> o') -> n -> n'
over Maybe (DUALTreeU d u a l) -> DUALTree d u a l
forall d u a l. Maybe (DUALTreeU d u a l) -> DUALTree d u a l
DUALTree ((Maybe (DUALTreeU d u a l) -> Maybe (DUALTreeU d u a l))
 -> DUALTree d u a l -> DUALTree d u a l)
-> (DAct d
    -> Maybe (DUALTreeU d u a l) -> Maybe (DUALTreeU d u a l))
-> DAct d
-> DUALTree d u a l
-> DUALTree d u a l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DUALTreeU d u a l -> DUALTreeU d u a l)
-> Maybe (DUALTreeU d u a l) -> Maybe (DUALTreeU d u a l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DUALTreeU d u a l -> DUALTreeU d u a l)
 -> Maybe (DUALTreeU d u a l) -> Maybe (DUALTreeU d u a l))
-> (DAct d -> DUALTreeU d u a l -> DUALTreeU d u a l)
-> DAct d
-> Maybe (DUALTreeU d u a l)
-> Maybe (DUALTreeU d u a l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DAct d -> DUALTreeU d u a l -> DUALTreeU d u a l
forall m s. Action m s => m -> s -> s
act

------------------------------------------------------------
-- Convenience methods etc.
------------------------------------------------------------

-- | The empty DUAL-tree.  This is a synonym for 'mempty', but with a
--   more general type.
empty :: DUALTree d u a l
empty :: DUALTree d u a l
empty = Maybe (DUALTreeU d u a l) -> DUALTree d u a l
forall d u a l. Maybe (DUALTreeU d u a l) -> DUALTree d u a l
DUALTree Maybe (DUALTreeU d u a l)
forall a. Maybe a
Nothing

-- | Construct a leaf node from a @u@ annotation along with a leaf
--   datum.
leaf :: u -> l -> DUALTree d u a l
leaf :: u -> l -> DUALTree d u a l
leaf u
u l
l = Maybe (DUALTreeU d u a l) -> DUALTree d u a l
forall d u a l. Maybe (DUALTreeU d u a l) -> DUALTree d u a l
DUALTree (DUALTreeU d u a l -> Maybe (DUALTreeU d u a l)
forall a. a -> Maybe a
Just ((u, DUALTreeNE d u a l) -> DUALTreeU d u a l
forall d u a l. (u, DUALTreeNE d u a l) -> DUALTreeU d u a l
DUALTreeU (u
u, u -> l -> DUALTreeNE d u a l
forall d u a l. u -> l -> DUALTreeNE d u a l
Leaf u
u l
l)))

-- | Construct a leaf node from a @u@ annotation.
leafU :: u -> DUALTree d u a l
leafU :: u -> DUALTree d u a l
leafU u
u = Maybe (DUALTreeU d u a l) -> DUALTree d u a l
forall d u a l. Maybe (DUALTreeU d u a l) -> DUALTree d u a l
DUALTree (DUALTreeU d u a l -> Maybe (DUALTreeU d u a l)
forall a. a -> Maybe a
Just ((u, DUALTreeNE d u a l) -> DUALTreeU d u a l
forall d u a l. (u, DUALTreeNE d u a l) -> DUALTreeU d u a l
DUALTreeU (u
u, u -> DUALTreeNE d u a l
forall d u a l. u -> DUALTreeNE d u a l
LeafU u
u)))

-- | Add a @u@ annotation to the root, combining it (on the left) with
--   the existing cached @u@ annotation.  This function is provided
--   just for convenience; @applyUpre u t = 'leafU' u \<\> t@.
applyUpre :: (Semigroup u, Action d u) => u -> DUALTree d u a l -> DUALTree d u a l
applyUpre :: u -> DUALTree d u a l -> DUALTree d u a l
applyUpre u
u DUALTree d u a l
t = u -> DUALTree d u a l
forall u d a l. u -> DUALTree d u a l
leafU u
u DUALTree d u a l -> DUALTree d u a l -> DUALTree d u a l
forall a. Semigroup a => a -> a -> a
<> DUALTree d u a l
t

-- | Add a @u@ annotation to the root, combining it (on the right) with
--   the existing cached @u@ annotation.  This function is provided
--   just for convenience; @applyUpost u t = t \<\> 'leafU' u@.
applyUpost :: (Semigroup u, Action d u) => u -> DUALTree d u a l -> DUALTree d u a l
applyUpost :: u -> DUALTree d u a l -> DUALTree d u a l
applyUpost u
u DUALTree d u a l
t = DUALTree d u a l
t DUALTree d u a l -> DUALTree d u a l -> DUALTree d u a l
forall a. Semigroup a => a -> a -> a
<> u -> DUALTree d u a l
forall u d a l. u -> DUALTree d u a l
leafU u
u

-- | Add an internal data value at the root of a tree.  Note that this
--   only works on /non-empty/ trees; on empty trees this function is
--   the identity.
annot :: (Semigroup u, Action d u) => a -> DUALTree d u a l -> DUALTree d u a l
annot :: a -> DUALTree d u a l -> DUALTree d u a l
annot a
a = ((Maybe (DUALTreeU d u a l) -> DUALTree d u a l)
-> (Maybe (DUALTreeU d u a l) -> Maybe (DUALTreeU d u a l))
-> DUALTree d u a l
-> DUALTree d u a l
forall n n' o' o.
(Newtype n, Newtype n', o' ~ O n', o ~ O n) =>
(o -> n) -> (o -> o') -> n -> n'
over Maybe (DUALTreeU d u a l) -> DUALTree d u a l
forall d u a l. Maybe (DUALTreeU d u a l) -> DUALTree d u a l
DUALTree ((Maybe (DUALTreeU d u a l) -> Maybe (DUALTreeU d u a l))
 -> DUALTree d u a l -> DUALTree d u a l)
-> ((DUALTreeU d u a l -> DUALTreeU d u a l)
    -> Maybe (DUALTreeU d u a l) -> Maybe (DUALTreeU d u a l))
-> (DUALTreeU d u a l -> DUALTreeU d u a l)
-> DUALTree d u a l
-> DUALTree d u a l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DUALTreeU d u a l -> DUALTreeU d u a l)
-> Maybe (DUALTreeU d u a l) -> Maybe (DUALTreeU d u a l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (DUALTreeNE d u a l -> DUALTreeU d u a l
forall u d a l.
(Semigroup u, Action d u) =>
DUALTreeNE d u a l -> DUALTreeU d u a l
pullU (DUALTreeNE d u a l -> DUALTreeU d u a l)
-> (DUALTreeU d u a l -> DUALTreeNE d u a l)
-> DUALTreeU d u a l
-> DUALTreeU d u a l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> DUALTreeU d u a l -> DUALTreeNE d u a l
forall d u a l. a -> DUALTreeU d u a l -> DUALTreeNE d u a l
Annot a
a)

-- | Apply a @d@ annotation at the root of a tree, transforming all
--   @u@ annotations by the action of @d@.
applyD :: (Semigroup d, Semigroup u, Action d u)
       => d -> DUALTree d u a l -> DUALTree d u a l
applyD :: d -> DUALTree d u a l -> DUALTree d u a l
applyD = DAct d -> DUALTree d u a l -> DUALTree d u a l
forall m s. Action m s => m -> s -> s
act (DAct d -> DUALTree d u a l -> DUALTree d u a l)
-> (d -> DAct d) -> d -> DUALTree d u a l -> DUALTree d u a l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> DAct d
forall d. d -> DAct d
DAct

-- | Decompose a DUAL-tree into either @Nothing@ (if empty) or a
--   top-level cached @u@ annotation paired with a non-empty
--   DUAL-tree.
nonEmpty :: DUALTree d u a l -> Maybe (u, DUALTreeNE d u a l)
nonEmpty :: DUALTree d u a l -> Maybe (u, DUALTreeNE d u a l)
nonEmpty = (DUALTreeU d u a l -> (u, DUALTreeNE d u a l))
-> Maybe (DUALTreeU d u a l) -> Maybe (u, DUALTreeNE d u a l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DUALTreeU d u a l -> (u, DUALTreeNE d u a l)
forall n. Newtype n => n -> O n
unpack (Maybe (DUALTreeU d u a l) -> Maybe (u, DUALTreeNE d u a l))
-> (DUALTree d u a l -> Maybe (DUALTreeU d u a l))
-> DUALTree d u a l
-> Maybe (u, DUALTreeNE d u a l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DUALTree d u a l -> Maybe (DUALTreeU d u a l)
forall n. Newtype n => n -> O n
unpack

-- | Get the @u@ annotation at the root, or @Nothing@ if the tree is
--   empty.
getU :: DUALTree d u a l -> Maybe u
getU :: DUALTree d u a l -> Maybe u
getU = ((u, DUALTreeNE d u a l) -> u)
-> Maybe (u, DUALTreeNE d u a l) -> Maybe u
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (u, DUALTreeNE d u a l) -> u
forall a b. (a, b) -> a
fst (Maybe (u, DUALTreeNE d u a l) -> Maybe u)
-> (DUALTree d u a l -> Maybe (u, DUALTreeNE d u a l))
-> DUALTree d u a l
-> Maybe u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DUALTree d u a l -> Maybe (u, DUALTreeNE d u a l)
forall d u a l. DUALTree d u a l -> Maybe (u, DUALTreeNE d u a l)
nonEmpty

------------------------------------------------------------
-- Maps
------------------------------------------------------------

-- XXX todo: try adding Map as a constructor, so we can delay the
-- mapping until the end too?

-- | Map a function (which must be a monoid homomorphism, and commute
--   with the action of @d@) over all the @u@ annotations in a non-empty
--   DUAL-tree.
mapUNE :: (u -> u') -> DUALTreeNE d u a l -> DUALTreeNE d u' a l
mapUNE :: (u -> u') -> DUALTreeNE d u a l -> DUALTreeNE d u' a l
mapUNE u -> u'
f (Leaf u
u l
l)  = u' -> l -> DUALTreeNE d u' a l
forall d u a l. u -> l -> DUALTreeNE d u a l
Leaf (u -> u'
f u
u) l
l
mapUNE u -> u'
f (LeafU u
u)   = u' -> DUALTreeNE d u' a l
forall d u a l. u -> DUALTreeNE d u a l
LeafU (u -> u'
f u
u)
mapUNE u -> u'
f (Concat NonEmpty (DUALTreeU d u a l)
ts) = NonEmpty (DUALTreeU d u' a l) -> DUALTreeNE d u' a l
forall d u a l. NonEmpty (DUALTreeU d u a l) -> DUALTreeNE d u a l
Concat (((DUALTreeU d u a l -> DUALTreeU d u' a l)
-> NonEmpty (DUALTreeU d u a l) -> NonEmpty (DUALTreeU d u' a l)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NEL.map ((DUALTreeU d u a l -> DUALTreeU d u' a l)
 -> NonEmpty (DUALTreeU d u a l) -> NonEmpty (DUALTreeU d u' a l))
-> ((u -> u') -> DUALTreeU d u a l -> DUALTreeU d u' a l)
-> (u -> u')
-> NonEmpty (DUALTreeU d u a l)
-> NonEmpty (DUALTreeU d u' a l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (u -> u') -> DUALTreeU d u a l -> DUALTreeU d u' a l
forall u u' d a l.
(u -> u') -> DUALTreeU d u a l -> DUALTreeU d u' a l
mapUU) u -> u'
f NonEmpty (DUALTreeU d u a l)
ts)
mapUNE u -> u'
f (Act d
d DUALTreeU d u a l
t)   = d -> DUALTreeU d u' a l -> DUALTreeNE d u' a l
forall d u a l. d -> DUALTreeU d u a l -> DUALTreeNE d u a l
Act d
d ((u -> u') -> DUALTreeU d u a l -> DUALTreeU d u' a l
forall u u' d a l.
(u -> u') -> DUALTreeU d u a l -> DUALTreeU d u' a l
mapUU u -> u'
f DUALTreeU d u a l
t)
mapUNE u -> u'
f (Annot a
a DUALTreeU d u a l
t) = a -> DUALTreeU d u' a l -> DUALTreeNE d u' a l
forall d u a l. a -> DUALTreeU d u a l -> DUALTreeNE d u a l
Annot a
a ((u -> u') -> DUALTreeU d u a l -> DUALTreeU d u' a l
forall u u' d a l.
(u -> u') -> DUALTreeU d u a l -> DUALTreeU d u' a l
mapUU u -> u'
f DUALTreeU d u a l
t)

-- | Map a function (which must be a monoid homomorphism, and commute
--   with the action of @d@) over all the @u@ annotations in a
--   non-empty DUAL-tree paired with its cached @u@ value.
mapUU :: (u -> u') -> DUALTreeU d u a l -> DUALTreeU d u' a l
mapUU :: (u -> u') -> DUALTreeU d u a l -> DUALTreeU d u' a l
mapUU u -> u'
f = ((u, DUALTreeNE d u a l) -> DUALTreeU d u a l)
-> ((u, DUALTreeNE d u a l) -> (u', DUALTreeNE d u' a l))
-> DUALTreeU d u a l
-> DUALTreeU d u' a l
forall n n' o' o.
(Newtype n, Newtype n', o' ~ O n', o ~ O n) =>
(o -> n) -> (o -> o') -> n -> n'
over (u, DUALTreeNE d u a l) -> DUALTreeU d u a l
forall d u a l. (u, DUALTreeNE d u a l) -> DUALTreeU d u a l
DUALTreeU (u -> u'
f (u -> u')
-> (DUALTreeNE d u a l -> DUALTreeNE d u' a l)
-> (u, DUALTreeNE d u a l)
-> (u', DUALTreeNE d u' a l)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (u -> u') -> DUALTreeNE d u a l -> DUALTreeNE d u' a l
forall u u' d a l.
(u -> u') -> DUALTreeNE d u a l -> DUALTreeNE d u' a l
mapUNE u -> u'
f)

-- | Map a function over all the @u@ annotations in a DUAL-tree.  The
--   function must be a monoid homomorphism, and must commute with the
--   action of @d@ on @u@.  That is, to use @mapU f@ safely it must be
--   the case that
--
--     * @f mempty == mempty@
--
--     * @f (u1 \<\> u2) == f u1 \<\> f u2@
--
--     * @f (act d u) == act d (f u)@
--
mapU :: (u -> u') -> DUALTree d u a l -> DUALTree d u' a l
mapU :: (u -> u') -> DUALTree d u a l -> DUALTree d u' a l
mapU = (Maybe (DUALTreeU d u a l) -> DUALTree d u a l)
-> (Maybe (DUALTreeU d u a l) -> Maybe (DUALTreeU d u' a l))
-> DUALTree d u a l
-> DUALTree d u' a l
forall n n' o' o.
(Newtype n, Newtype n', o' ~ O n', o ~ O n) =>
(o -> n) -> (o -> o') -> n -> n'
over Maybe (DUALTreeU d u a l) -> DUALTree d u a l
forall d u a l. Maybe (DUALTreeU d u a l) -> DUALTree d u a l
DUALTree ((Maybe (DUALTreeU d u a l) -> Maybe (DUALTreeU d u' a l))
 -> DUALTree d u a l -> DUALTree d u' a l)
-> ((u -> u')
    -> Maybe (DUALTreeU d u a l) -> Maybe (DUALTreeU d u' a l))
-> (u -> u')
-> DUALTree d u a l
-> DUALTree d u' a l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DUALTreeU d u a l -> DUALTreeU d u' a l)
-> Maybe (DUALTreeU d u a l) -> Maybe (DUALTreeU d u' a l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DUALTreeU d u a l -> DUALTreeU d u' a l)
 -> Maybe (DUALTreeU d u a l) -> Maybe (DUALTreeU d u' a l))
-> ((u -> u') -> DUALTreeU d u a l -> DUALTreeU d u' a l)
-> (u -> u')
-> Maybe (DUALTreeU d u a l)
-> Maybe (DUALTreeU d u' a l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (u -> u') -> DUALTreeU d u a l -> DUALTreeU d u' a l
forall u u' d a l.
(u -> u') -> DUALTreeU d u a l -> DUALTreeU d u' a l
mapUU

------------------------------------------------------------
-- Folds
------------------------------------------------------------

-- | Fold for non-empty DUAL-trees.
foldDUALNE :: (Semigroup d, Monoid d)
           => (d -> l -> r) -- ^ Process a leaf datum along with the
                            --   accumulation of @d@ values along the
                            --   path from the root
           -> r             -- ^ Replace @LeafU@ nodes
           -> (NonEmpty r -> r)  -- ^ Combine results at a branch node
           -> (d -> r -> r)      -- ^ Process an internal d node
           -> (a -> r -> r)      -- ^ Process an internal datum
           -> DUALTreeNE d u a l -> r
foldDUALNE :: (d -> l -> r)
-> r
-> (NonEmpty r -> r)
-> (d -> r -> r)
-> (a -> r -> r)
-> DUALTreeNE d u a l
-> r
foldDUALNE  = Maybe d
-> (d -> l -> r)
-> r
-> (NonEmpty r -> r)
-> (d -> r -> r)
-> (a -> r -> r)
-> DUALTreeNE d u a l
-> r
forall t t t t a.
Monoid t =>
Maybe t
-> (t -> t -> t)
-> t
-> (NonEmpty t -> t)
-> (t -> t -> t)
-> (t -> t -> t)
-> DUALTreeNE t a t t
-> t
foldDUALNE' Maybe d
forall a. Maybe a
Nothing
  where
    foldDUALNE' :: Maybe t
-> (t -> t -> t)
-> t
-> (NonEmpty t -> t)
-> (t -> t -> t)
-> (t -> t -> t)
-> DUALTreeNE t a t t
-> t
foldDUALNE' Maybe t
dacc t -> t -> t
lf t
_   NonEmpty t -> t
_   t -> t -> t
_    t -> t -> t
_   (Leaf a
_ t
l)  = t -> t -> t
lf (t -> (t -> t) -> Maybe t -> t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe t
forall a. Monoid a => a
mempty t -> t
forall a. a -> a
id Maybe t
dacc) t
l
    foldDUALNE' Maybe t
_    t -> t -> t
_  t
lfU NonEmpty t -> t
_   t -> t -> t
_    t -> t -> t
_   (LeafU a
_)   = t
lfU
    foldDUALNE' Maybe t
dacc t -> t -> t
lf t
lfU NonEmpty t -> t
con t -> t -> t
down t -> t -> t
ann (Concat NonEmpty (DUALTreeU t a t t)
ts)
      = NonEmpty t -> t
con ((DUALTreeU t a t t -> t)
-> NonEmpty (DUALTreeU t a t t) -> NonEmpty t
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NEL.map (Maybe t
-> (t -> t -> t)
-> t
-> (NonEmpty t -> t)
-> (t -> t -> t)
-> (t -> t -> t)
-> DUALTreeNE t a t t
-> t
foldDUALNE' Maybe t
dacc t -> t -> t
lf t
lfU NonEmpty t -> t
con t -> t -> t
down t -> t -> t
ann (DUALTreeNE t a t t -> t)
-> (DUALTreeU t a t t -> DUALTreeNE t a t t)
-> DUALTreeU t a t t
-> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, DUALTreeNE t a t t) -> DUALTreeNE t a t t
forall a b. (a, b) -> b
snd ((a, DUALTreeNE t a t t) -> DUALTreeNE t a t t)
-> (DUALTreeU t a t t -> (a, DUALTreeNE t a t t))
-> DUALTreeU t a t t
-> DUALTreeNE t a t t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DUALTreeU t a t t -> (a, DUALTreeNE t a t t)
forall n. Newtype n => n -> O n
unpack) NonEmpty (DUALTreeU t a t t)
ts)
    foldDUALNE' Maybe t
dacc t -> t -> t
lf t
lfU NonEmpty t -> t
con t -> t -> t
down t -> t -> t
ann (Act t
d DUALTreeU t a t t
t)
      = t -> t -> t
down t
d (Maybe t
-> (t -> t -> t)
-> t
-> (NonEmpty t -> t)
-> (t -> t -> t)
-> (t -> t -> t)
-> DUALTreeNE t a t t
-> t
foldDUALNE' (Maybe t
dacc Maybe t -> Maybe t -> Maybe t
forall a. Semigroup a => a -> a -> a
<> t -> Maybe t
forall a. a -> Maybe a
Just t
d) t -> t -> t
lf t
lfU NonEmpty t -> t
con t -> t -> t
down t -> t -> t
ann (DUALTreeNE t a t t -> t)
-> (DUALTreeU t a t t -> DUALTreeNE t a t t)
-> DUALTreeU t a t t
-> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, DUALTreeNE t a t t) -> DUALTreeNE t a t t
forall a b. (a, b) -> b
snd ((a, DUALTreeNE t a t t) -> DUALTreeNE t a t t)
-> (DUALTreeU t a t t -> (a, DUALTreeNE t a t t))
-> DUALTreeU t a t t
-> DUALTreeNE t a t t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DUALTreeU t a t t -> (a, DUALTreeNE t a t t)
forall n. Newtype n => n -> O n
unpack (DUALTreeU t a t t -> t) -> DUALTreeU t a t t -> t
forall a b. (a -> b) -> a -> b
$ DUALTreeU t a t t
t)
    foldDUALNE' Maybe t
dacc t -> t -> t
lf t
lfU NonEmpty t -> t
con t -> t -> t
down t -> t -> t
ann (Annot t
a DUALTreeU t a t t
t)
      = t -> t -> t
ann t
a (Maybe t
-> (t -> t -> t)
-> t
-> (NonEmpty t -> t)
-> (t -> t -> t)
-> (t -> t -> t)
-> DUALTreeNE t a t t
-> t
foldDUALNE' Maybe t
dacc t -> t -> t
lf t
lfU NonEmpty t -> t
con t -> t -> t
down t -> t -> t
ann (DUALTreeNE t a t t -> t)
-> (DUALTreeU t a t t -> DUALTreeNE t a t t)
-> DUALTreeU t a t t
-> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, DUALTreeNE t a t t) -> DUALTreeNE t a t t
forall a b. (a, b) -> b
snd ((a, DUALTreeNE t a t t) -> DUALTreeNE t a t t)
-> (DUALTreeU t a t t -> (a, DUALTreeNE t a t t))
-> DUALTreeU t a t t
-> DUALTreeNE t a t t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DUALTreeU t a t t -> (a, DUALTreeNE t a t t)
forall n. Newtype n => n -> O n
unpack (DUALTreeU t a t t -> t) -> DUALTreeU t a t t -> t
forall a b. (a -> b) -> a -> b
$ DUALTreeU t a t t
t)

-- | Fold for DUAL-trees. It is given access to the internal and leaf
--   data, internal @d@ values, and the accumulated @d@ values at each
--   leaf.  It is also allowed to replace \"@u@-only\" leaves with a
--   constant value.  In particular, however, it is /not/ given access
--   to any of the @u@ annotations, the idea being that those are used
--   only for /constructing/ trees.  If you do need access to @u@
--   values, you can duplicate the values you need in the internal
--   data nodes.
--
--   Be careful not to mix up the @d@ values at internal nodes with
--   the @d@ values at leaves.  Each @d@ value at a leaf satisfies the
--   property that it is the 'mconcat' of all internal @d@ values
--   along the path from the root to the leaf.
--
--   The result is @Nothing@ if and only if the tree is empty.
foldDUAL :: (Semigroup d, Monoid d)
         => (d -> l -> r)          -- ^ Process a leaf datum along with the
                                   --   accumulation of @d@ values along the
                                   --   path from the root
         -> r                      -- ^ Replace @u@-only nodes
         -> (NonEmpty r -> r)      -- ^ Combine results at a branch node
         -> (d -> r -> r)          -- ^ Process an internal d node
         -> (a -> r -> r)          -- ^ Process an internal datum
         -> DUALTree d u a l -> Maybe r
foldDUAL :: (d -> l -> r)
-> r
-> (NonEmpty r -> r)
-> (d -> r -> r)
-> (a -> r -> r)
-> DUALTree d u a l
-> Maybe r
foldDUAL d -> l -> r
_ r
_ NonEmpty r -> r
_ d -> r -> r
_ a -> r -> r
_ (DUALTree Maybe (DUALTreeU d u a l)
Nothing)
  = Maybe r
forall a. Maybe a
Nothing
foldDUAL d -> l -> r
l r
u NonEmpty r -> r
c d -> r -> r
d a -> r -> r
a (DUALTree (Just (DUALTreeU (u
_, DUALTreeNE d u a l
t))))
  = r -> Maybe r
forall a. a -> Maybe a
Just (r -> Maybe r) -> r -> Maybe r
forall a b. (a -> b) -> a -> b
$ (d -> l -> r)
-> r
-> (NonEmpty r -> r)
-> (d -> r -> r)
-> (a -> r -> r)
-> DUALTreeNE d u a l
-> r
forall d l r a u.
(Semigroup d, Monoid d) =>
(d -> l -> r)
-> r
-> (NonEmpty r -> r)
-> (d -> r -> r)
-> (a -> r -> r)
-> DUALTreeNE d u a l
-> r
foldDUALNE d -> l -> r
l r
u NonEmpty r -> r
c d -> r -> r
d a -> r -> r
a DUALTreeNE d u a l
t

-- | A specialized fold provided for convenience: flatten a tree into
--   a list of leaves along with their @d@ annotations, ignoring
--   internal data values.
flatten :: (Semigroup d, Monoid d) => DUALTree d u a l -> [(l, d)]
flatten :: DUALTree d u a l -> [(l, d)]
flatten = [(l, d)] -> Maybe [(l, d)] -> [(l, d)]
forall a. a -> Maybe a -> a
fromMaybe []
        (Maybe [(l, d)] -> [(l, d)])
-> (DUALTree d u a l -> Maybe [(l, d)])
-> DUALTree d u a l
-> [(l, d)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (d -> l -> [(l, d)])
-> [(l, d)]
-> (NonEmpty [(l, d)] -> [(l, d)])
-> (d -> [(l, d)] -> [(l, d)])
-> (a -> [(l, d)] -> [(l, d)])
-> DUALTree d u a l
-> Maybe [(l, d)]
forall d l r a u.
(Semigroup d, Monoid d) =>
(d -> l -> r)
-> r
-> (NonEmpty r -> r)
-> (d -> r -> r)
-> (a -> r -> r)
-> DUALTree d u a l
-> Maybe r
foldDUAL
            (\d
d l
l -> [(l
l, d
d)])
            []
            ([[(l, d)]] -> [(l, d)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(l, d)]] -> [(l, d)])
-> (NonEmpty [(l, d)] -> [[(l, d)]])
-> NonEmpty [(l, d)]
-> [(l, d)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty [(l, d)] -> [[(l, d)]]
forall a. NonEmpty a -> [a]
NEL.toList)
            (([(l, d)] -> d -> [(l, d)]) -> d -> [(l, d)] -> [(l, d)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [(l, d)] -> d -> [(l, d)]
forall a b. a -> b -> a
const)
            (([(l, d)] -> [(l, d)]) -> a -> [(l, d)] -> [(l, d)]
forall a b. a -> b -> a
const [(l, d)] -> [(l, d)]
forall a. a -> a
id)