{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.LCA.View
-- Copyright   :  (C) 2012-2015 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
-----------------------------------------------------------------------------
module Data.LCA.View (View(..)) where

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
import Data.Foldable
import Data.Traversable
import Data.Monoid
#endif

-- | Provides a consistent 'View' for peeling off the bottom node of a path.
data View f a
  = Root
  | Node {-# UNPACK #-} !Int a (f a)
  deriving (View f a -> View f a -> Bool
(View f a -> View f a -> Bool)
-> (View f a -> View f a -> Bool) -> Eq (View f a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *) a.
(Eq a, Eq (f a)) =>
View f a -> View f a -> Bool
/= :: View f a -> View f a -> Bool
$c/= :: forall (f :: * -> *) a.
(Eq a, Eq (f a)) =>
View f a -> View f a -> Bool
== :: View f a -> View f a -> Bool
$c== :: forall (f :: * -> *) a.
(Eq a, Eq (f a)) =>
View f a -> View f a -> Bool
Eq,Eq (View f a)
Eq (View f a)
-> (View f a -> View f a -> Ordering)
-> (View f a -> View f a -> Bool)
-> (View f a -> View f a -> Bool)
-> (View f a -> View f a -> Bool)
-> (View f a -> View f a -> Bool)
-> (View f a -> View f a -> View f a)
-> (View f a -> View f a -> View f a)
-> Ord (View f a)
View f a -> View f a -> Bool
View f a -> View f a -> Ordering
View f a -> View f a -> View f 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 (f :: * -> *) a. (Ord a, Ord (f a)) => Eq (View f a)
forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
View f a -> View f a -> Bool
forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
View f a -> View f a -> Ordering
forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
View f a -> View f a -> View f a
min :: View f a -> View f a -> View f a
$cmin :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
View f a -> View f a -> View f a
max :: View f a -> View f a -> View f a
$cmax :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
View f a -> View f a -> View f a
>= :: View f a -> View f a -> Bool
$c>= :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
View f a -> View f a -> Bool
> :: View f a -> View f a -> Bool
$c> :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
View f a -> View f a -> Bool
<= :: View f a -> View f a -> Bool
$c<= :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
View f a -> View f a -> Bool
< :: View f a -> View f a -> Bool
$c< :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
View f a -> View f a -> Bool
compare :: View f a -> View f a -> Ordering
$ccompare :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
View f a -> View f a -> Ordering
$cp1Ord :: forall (f :: * -> *) a. (Ord a, Ord (f a)) => Eq (View f a)
Ord,ReadPrec [View f a]
ReadPrec (View f a)
Int -> ReadS (View f a)
ReadS [View f a]
(Int -> ReadS (View f a))
-> ReadS [View f a]
-> ReadPrec (View f a)
-> ReadPrec [View f a]
-> Read (View f a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (f :: * -> *) a. (Read a, Read (f a)) => ReadPrec [View f a]
forall (f :: * -> *) a. (Read a, Read (f a)) => ReadPrec (View f a)
forall (f :: * -> *) a.
(Read a, Read (f a)) =>
Int -> ReadS (View f a)
forall (f :: * -> *) a. (Read a, Read (f a)) => ReadS [View f a]
readListPrec :: ReadPrec [View f a]
$creadListPrec :: forall (f :: * -> *) a. (Read a, Read (f a)) => ReadPrec [View f a]
readPrec :: ReadPrec (View f a)
$creadPrec :: forall (f :: * -> *) a. (Read a, Read (f a)) => ReadPrec (View f a)
readList :: ReadS [View f a]
$creadList :: forall (f :: * -> *) a. (Read a, Read (f a)) => ReadS [View f a]
readsPrec :: Int -> ReadS (View f a)
$creadsPrec :: forall (f :: * -> *) a.
(Read a, Read (f a)) =>
Int -> ReadS (View f a)
Read,Int -> View f a -> ShowS
[View f a] -> ShowS
View f a -> String
(Int -> View f a -> ShowS)
-> (View f a -> String) -> ([View f a] -> ShowS) -> Show (View f a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *) a.
(Show a, Show (f a)) =>
Int -> View f a -> ShowS
forall (f :: * -> *) a. (Show a, Show (f a)) => [View f a] -> ShowS
forall (f :: * -> *) a. (Show a, Show (f a)) => View f a -> String
showList :: [View f a] -> ShowS
$cshowList :: forall (f :: * -> *) a. (Show a, Show (f a)) => [View f a] -> ShowS
show :: View f a -> String
$cshow :: forall (f :: * -> *) a. (Show a, Show (f a)) => View f a -> String
showsPrec :: Int -> View f a -> ShowS
$cshowsPrec :: forall (f :: * -> *) a.
(Show a, Show (f a)) =>
Int -> View f a -> ShowS
Show)

instance Functor f => Functor (View f) where
  fmap :: (a -> b) -> View f a -> View f b
fmap a -> b
_ View f a
Root = View f b
forall (f :: * -> *) a. View f a
Root
  fmap a -> b
f (Node Int
k a
a f a
as) = Int -> b -> f b -> View f b
forall (f :: * -> *) a. Int -> a -> f a -> View f a
Node Int
k (a -> b
f a
a) ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
as)

instance Foldable f => Foldable (View f) where
  foldMap :: (a -> m) -> View f a -> m
foldMap a -> m
_ View f a
Root = m
forall a. Monoid a => a
mempty
  foldMap a -> m
f (Node Int
_ a
a f a
as) = a -> m
f a
a m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f f a
as

instance Traversable f => Traversable (View f) where
  traverse :: (a -> f b) -> View f a -> f (View f b)
traverse a -> f b
_ View f a
Root = View f b -> f (View f b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure View f b
forall (f :: * -> *) a. View f a
Root
  traverse a -> f b
f (Node Int
k a
a f a
as) = Int -> b -> f b -> View f b
forall (f :: * -> *) a. Int -> a -> f a -> View f a
Node Int
k (b -> f b -> View f b) -> f b -> f (f b -> View f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a f (f b -> View f b) -> f (f b) -> f (View f b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> f a -> f (f b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f f a
as