{-# LANGUAGE BangPatterns #-} {- | This module provides the 'Str' data type, which is used by the underlying 'uniplate' and 'biplate' methods. It should not be used directly under normal circumstances. -} module Data.Generics.Str where import Data.Generics.Uniplate.Internal.Utils import Control.Applicative import Control.Monad import Data.Foldable import Data.Monoid import Data.Traversable -- * The Data Type data Str a = Zero | One a | Two (Str a) (Str a) deriving Show instance Eq a => Eq (Str a) where Zero == Zero = True One x == One y = x == y Two x1 x2 == Two y1 y2 = x1 == y1 && x2 == y2 _ == _ = False {-# INLINE strMap #-} strMap :: (a -> b) -> Str a -> Str b strMap f x = g SPEC x where g !spec Zero = Zero g !spec (One x) = One $ f x g !spec (Two x y) = Two (g spec x) (g spec y) {-# INLINE strMapM #-} strMapM :: Monad m => (a -> m b) -> Str a -> m (Str b) strMapM f x = g SPEC x where g !spec Zero = return Zero g !spec (One x) = liftM One $ f x g !spec (Two x y) = liftM2 Two (g spec x) (g spec y) instance Functor Str where fmap f Zero = Zero fmap f (One x) = One (f x) fmap f (Two x y) = Two (fmap f x) (fmap f y) instance Foldable Str where foldMap m Zero = mempty foldMap m (One x) = m x foldMap m (Two l r) = foldMap m l `mappend` foldMap m r instance Traversable Str where traverse f Zero = pure Zero traverse f (One x) = One <$> f x traverse f (Two x y) = Two <$> traverse f x <*> traverse f y -- | Take the type of the method, will crash if called strType :: Str a -> a strType = error "Data.Generics.Str.strType: Cannot be called" -- | Convert a 'Str' to a list, assumes the value was created -- with 'listStr' strList :: Str a -> [a] strList x = builder (f x) where f (Two (One x) xs) cons nil = x `cons` f xs cons nil f Zero cons nil = nil -- | Convert a list to a 'Str' listStr :: [a] -> Str a listStr (x:xs) = Two (One x) (listStr xs) listStr [] = Zero -- | Transform a 'Str' to a list, and back again, in a structure -- preserving way. The output and input lists must be equal in -- length. strStructure :: Str a -> ([a], [a] -> Str a) strStructure x = (g x [], fst . f x) where g :: Str a -> [a] -> [a] g Zero xs = xs g (One x) xs = x:xs g (Two a b) xs = g a (g b xs) f :: Str a -> [a] -> (Str a, [a]) f Zero rs = (Zero, rs) f (One _) (r:rs) = (One r, rs) f (Two a b) rs1 = (Two a2 b2, rs3) where (a2,rs2) = f a rs1 (b2,rs3) = f b rs2