{- |
   The Footing module contains various low-level miscellaneous
   operations that are useful in multiple higher-level Modules.  Many
   of these represent functions that would better fit in various
   Data.XXX modules, but are not presently defined therein. -}

module Footing (
                 -- ** Supplement to Data.Either
                 ifRight, ifRight2, ifRight3, ifLeftShowS,
                 -- ** Supplement to Data.List
                 zeroOneMany,
                 -- ** Supplement to Data.Tree
                 mapTreeM, mapTreeNode, mapTreeNodeM,
                 resizeTree, resizeTreeM
               )
    where

import Data.Tree


{- |
   Supplement to the "Data.Either" module.  Transforms the second
   argument via the function, but only if the second argument is
   Right; if it is Left, it is passed unchanged.  The result is still
   Either. -}

ifRight :: (a -> b) -> Either c a -> Either c b
ifRight _ (Left e)  = Left e
ifRight f (Right x) = Right $ f x

{- |
   Supplement to the "Data.Either" module.  Extends 'ifRight', but
   with two arguments, but of which must be Right to call the
   transformation function (with both arguments). 

   Note that the Left value must be the same type for both arguments.
   Also, the first Left value (if any) is the resulting value of this
   function; subsequent Either values are discarded.
-}

ifRight2 :: (a -> b -> c) -> Either d a -> Either d b -> Either d c
ifRight2 _ (Left e)  _         = Left e
ifRight2 _ _         (Left e)  = Left e
ifRight2 f (Right x) (Right y) = Right $ f x y

{- |
   Supplement to the "Data.Either" module.  Extends 'ifRight' and
   'ifRight2' to a 3 argument transformation. -}

ifRight3 :: (a -> b -> c -> d) -> (Either e a) -> (Either e b) -> (Either e c) -> Either e d
ifRight3 _ (Left e) _ _ = Left e
ifRight3 _ _ (Left e) _ = Left e
ifRight3 _ _ _ (Left e) = Left e
ifRight3 f (Right x) (Right y) (Right z) = Right $ f x y z


{- |
   Supplement to the "Data.Either" module.  Applies "shows" to the
   argument if it is a 'Left'; returns 'Right' unchanged. -}

ifLeftShowS :: (Show a) => Either a b -> Either ShowS b
ifLeftShowS = either (Left . shows) Right


{- |
   This little function /really/ should have been part of "Data.List".
   The 'zeroOneMany' convenience function can be used for lists in a
   similar manner that 'maybe' is used for the 'Maybe' type and
   'either' is used for the 'Either' type.  The last argument passed
   to 'zeroOneMany' is a list:

   * if the list is empty, the result of zeroOneMany is the first
     argument

   * if the list contains only one element, the result of zeroOneMany
     is the result of calling the second argument (a function) and
     passing the sole list entry as an argument to that function.

   * if the list contains more than one element, the entire list is
     passed to the third argument (a function) and that functions
     return value is the return value of zeroOneMany.
-}

zeroOneMany :: b -> (a -> b) -> ([a] -> b) -> [a] -> b
zeroOneMany z o m l | null l        = z
                    | 1 == length l = o $ head l
                    | otherwise     = m l



{- |
   This little function /really/ should have been part of "Data.Tree".
   The @fmap@ operation allows the mapping of functions across nodes
   in a tree, but when mapping a monadic function @(a -> m b)@ across
   nodes of a tree, the result @m (Tree b)@ is often more desireable
   than @Tree (m b)@.  The latter can be achieved using @fmap@, and
   this 'mapTreeM' function provides the former:

   >   o :: a -> m b

   >   fmap o     :: Tree a -> Tree (m b)
   >   mapTreeM o :: Tree a -> m (Tree b)
-}

mapTreeM :: (Monad m) => (a -> m b) -> Tree a -> m (Tree b)
mapTreeM f (Node x ts) = do x' <- f x
                            ts' <- mapM (mapTreeM f) ts
                            return $ Node x' ts'


{- | 
   Processes a tree by applying a function that converts the entire
   tree node into a new tree node.  Similar to mapTree, except the
   latter operates only on the rootLabel of each tree node, whereas
   this function is passed the entire 'Node'.

   One peculiarity is that the function is passed a Node and returns a
   Node, but the subForest of the returned Node is ignored (and may be
   the empty list).  See 'resizeTree' for more information. -}

mapTreeNode :: (Tree a -> Tree b) -> Tree a -> Tree b
mapTreeNode f node = let node' = f node
                         subnodes' = map (mapTreeNode f) (subForest node)
                    in Node (rootLabel node') subnodes'

-- | Monadic version of mapTreeNode.

mapTreeNodeM :: (Monad m) => (Tree a -> m (Tree b)) -> Tree a -> m (Tree b)
mapTreeNodeM f node = do node' <- f node
                         subnodes' <- mapM (mapTreeNodeM f) (subForest node)
                         return $ Node (rootLabel node') subnodes'

{- |
   Processes a tree by applying a function that can change the
   subForest for each tree node, given the node's rootLabel and the
   current subForest.  This is commonly used to add elements to or
   remove elements from an existing tree based on the siblings at each
   node of the tree (a good example would be applying 'nub' to the
   'subForest' at each level).

   This is slightly different than 'mapTreeNode', because that function
   is designed to change the nodes of the tree from one rootLabel to
   another, using the entire Node as the basis for the change.  More
   explicitly, 'mapTreeNode' ignores any changes to the subForest when
   processing a node, because the input function is defined as (a->b)
   and a tree must be a homogeneous type, so a node of type b must
   have a subForest of types b, implying conversion has already
   occurred.

   This function preserves the type of each node, but it allows a
   modification to the instances in the subForest.
-}

resizeTree :: (Tree a -> Tree a) -> Tree a -> Tree a
resizeTree f n = let n' = f n in Node (rootLabel n') (map (resizeTree f) (subForest n'))

-- | Monadic version of resizeTree

resizeTreeM :: (Monad m) => (Tree a -> m (Tree a)) -> Tree a -> m (Tree a)
resizeTreeM f n = do r <- f n
                     s <- mapM (resizeTreeM f) (subForest r)
                     return $ Node (rootLabel r) s