module Data.Fold.Internal
( SnocList(..)
, Maybe'(..), maybe'
, Pair'(..)
, N(..)
, Tree(..)
) where
import Control.Applicative
import Data.Data
import Data.Foldable
import Data.Monoid
import Data.Proxy
import Data.Reflection
import Data.Traversable
data SnocList a = Snoc (SnocList a) a | Nil
deriving (Eq,Ord,Show,Read,Typeable,Data)
instance Functor SnocList where
fmap f (Snoc xs x) = Snoc (fmap f xs) (f x)
fmap _ Nil = Nil
instance Foldable SnocList where
foldl f z m0 = go m0 where
go (Snoc xs x) = f (go xs) x
go Nil = z
foldMap f (Snoc xs x) = foldMap f xs `mappend` f x
foldMap _ Nil = mempty
instance Traversable SnocList where
traverse f (Snoc xs x) = Snoc <$> traverse f xs <*> f x
traverse _ Nil = pure Nil
data Maybe' a = Nothing' | Just' !a
deriving (Eq,Ord,Show,Read,Typeable,Data)
instance Foldable Maybe' where
foldMap _ Nothing' = mempty
foldMap f (Just' a) = f a
maybe' :: b -> (a -> b) -> Maybe' a -> b
maybe' _ f (Just' a) = f a
maybe' z _ Nothing' = z
newtype N a s = N { runN :: a }
deriving (Eq,Ord,Show,Read,Typeable,Data)
instance Reifies s (a -> a -> a, a) => Monoid (N a s) where
mempty = N $ snd $ reflect (Proxy :: Proxy s)
mappend (N a) (N b) = N $ fst (reflect (Proxy :: Proxy s)) a b
data Tree a
= Zero
| One a
| Two (Tree a) (Tree a)
deriving (Eq,Ord,Show,Read,Typeable,Data)
instance Functor Tree where
fmap _ Zero = Zero
fmap f (One a) = One (f a)
fmap f (Two a b) = Two (fmap f a) (fmap f b)
instance Foldable Tree where
foldMap _ Zero = mempty
foldMap f (One a) = f a
foldMap f (Two a b) = foldMap f a `mappend` foldMap f b
instance Traversable Tree where
traverse _ Zero = pure Zero
traverse f (One a) = One <$> f a
traverse f (Two a b) = Two <$> traverse f a <*> traverse f b
data Pair' a b = Pair' !a !b
deriving (Eq,Ord,Show,Read,Typeable,Data)
instance (Monoid a, Monoid b) => Monoid (Pair' a b) where
mempty = Pair' mempty mempty
mappend (Pair' a b) (Pair' c d) = Pair' (mappend a c) (mappend b d)