{-# LANGUAGE BangPatterns #-}
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
data Str a = Zero | One a | Two (Str a) (Str a)
deriving Int -> Str a -> ShowS
[Str a] -> ShowS
Str a -> String
(Int -> Str a -> ShowS)
-> (Str a -> String) -> ([Str a] -> ShowS) -> Show (Str a)
forall a. Show a => Int -> Str a -> ShowS
forall a. Show a => [Str a] -> ShowS
forall a. Show a => Str a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Str a] -> ShowS
$cshowList :: forall a. Show a => [Str a] -> ShowS
show :: Str a -> String
$cshow :: forall a. Show a => Str a -> String
showsPrec :: Int -> Str a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Str a -> ShowS
Show
instance Eq a => Eq (Str a) where
Zero == :: Str a -> Str a -> Bool
== Zero = Bool
True
One x :: a
x == One y :: a
y = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
Two x1 :: Str a
x1 x2 :: Str a
x2 == Two y1 :: Str a
y1 y2 :: Str a
y2 = Str a
x1 Str a -> Str a -> Bool
forall a. Eq a => a -> a -> Bool
== Str a
y1 Bool -> Bool -> Bool
&& Str a
x2 Str a -> Str a -> Bool
forall a. Eq a => a -> a -> Bool
== Str a
y2
_ == _ = Bool
False
{-# INLINE strMap #-}
strMap :: (a -> b) -> Str a -> Str b
strMap :: (a -> b) -> Str a -> Str b
strMap f :: a -> b
f x :: Str a
x = SPEC -> Str a -> Str b
forall t. t -> Str a -> Str b
g SPEC
SPEC Str a
x
where
g :: t -> Str a -> Str b
g !t
spec Zero = Str b
forall a. Str a
Zero
g !t
spec (One x :: a
x) = b -> Str b
forall a. a -> Str a
One (b -> Str b) -> b -> Str b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
g !t
spec (Two x :: Str a
x y :: Str a
y) = Str b -> Str b -> Str b
forall a. Str a -> Str a -> Str a
Two (t -> Str a -> Str b
g t
spec Str a
x) (t -> Str a -> Str b
g t
spec Str a
y)
{-# INLINE strMapM #-}
strMapM :: Monad m => (a -> m b) -> Str a -> m (Str b)
strMapM :: (a -> m b) -> Str a -> m (Str b)
strMapM f :: a -> m b
f x :: Str a
x = SPEC -> Str a -> m (Str b)
forall t. t -> Str a -> m (Str b)
g SPEC
SPEC Str a
x
where
g :: t -> Str a -> m (Str b)
g !t
spec Zero = Str b -> m (Str b)
forall (m :: * -> *) a. Monad m => a -> m a
return Str b
forall a. Str a
Zero
g !t
spec (One x :: a
x) = (b -> Str b) -> m b -> m (Str b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM b -> Str b
forall a. a -> Str a
One (m b -> m (Str b)) -> m b -> m (Str b)
forall a b. (a -> b) -> a -> b
$ a -> m b
f a
x
g !t
spec (Two x :: Str a
x y :: Str a
y) = (Str b -> Str b -> Str b) -> m (Str b) -> m (Str b) -> m (Str b)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Str b -> Str b -> Str b
forall a. Str a -> Str a -> Str a
Two (t -> Str a -> m (Str b)
g t
spec Str a
x) (t -> Str a -> m (Str b)
g t
spec Str a
y)
instance Functor Str where
fmap :: (a -> b) -> Str a -> Str b
fmap f :: a -> b
f Zero = Str b
forall a. Str a
Zero
fmap f :: a -> b
f (One x :: a
x) = b -> Str b
forall a. a -> Str a
One (a -> b
f a
x)
fmap f :: a -> b
f (Two x :: Str a
x y :: Str a
y) = Str b -> Str b -> Str b
forall a. Str a -> Str a -> Str a
Two ((a -> b) -> Str a -> Str b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Str a
x) ((a -> b) -> Str a -> Str b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Str a
y)
instance Foldable Str where
foldMap :: (a -> m) -> Str a -> m
foldMap m :: a -> m
m Zero = m
forall a. Monoid a => a
mempty
foldMap m :: a -> m
m (One x :: a
x) = a -> m
m a
x
foldMap m :: a -> m
m (Two l :: Str a
l r :: Str a
r) = (a -> m) -> Str a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
m Str a
l m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> Str a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
m Str a
r
instance Traversable Str where
traverse :: (a -> f b) -> Str a -> f (Str b)
traverse f :: a -> f b
f Zero = Str b -> f (Str b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Str b
forall a. Str a
Zero
traverse f :: a -> f b
f (One x :: a
x) = b -> Str b
forall a. a -> Str a
One (b -> Str b) -> f b -> f (Str b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
traverse f :: a -> f b
f (Two x :: Str a
x y :: Str a
y) = Str b -> Str b -> Str b
forall a. Str a -> Str a -> Str a
Two (Str b -> Str b -> Str b) -> f (Str b) -> f (Str b -> Str b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Str a -> f (Str b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Str a
x f (Str b -> Str b) -> f (Str b) -> f (Str b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Str a -> f (Str b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Str a
y
strType :: Str a -> a
strType :: Str a -> a
strType = String -> Str a -> a
forall a. HasCallStack => String -> a
error "Data.Generics.Str.strType: Cannot be called"
strList :: Str a -> [a]
strList :: Str a -> [a]
strList x :: Str a
x = (forall b. (a -> b -> b) -> b -> b) -> [a]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
builder (Str a -> (a -> b -> b) -> b -> b
forall t t. Str t -> (t -> t -> t) -> t -> t
f Str a
x)
where
f :: Str t -> (t -> t -> t) -> t -> t
f (Two (One x :: t
x) xs :: Str t
xs) cons :: t -> t -> t
cons nil :: t
nil = t
x t -> t -> t
`cons` Str t -> (t -> t -> t) -> t -> t
f Str t
xs t -> t -> t
cons t
nil
f Zero cons :: t -> t -> t
cons nil :: t
nil = t
nil
listStr :: [a] -> Str a
listStr :: [a] -> Str a
listStr (x :: a
x:xs :: [a]
xs) = Str a -> Str a -> Str a
forall a. Str a -> Str a -> Str a
Two (a -> Str a
forall a. a -> Str a
One a
x) ([a] -> Str a
forall a. [a] -> Str a
listStr [a]
xs)
listStr [] = Str a
forall a. Str a
Zero
strStructure :: Str a -> ([a], [a] -> Str a)
strStructure :: Str a -> ([a], [a] -> Str a)
strStructure x :: Str a
x = (Str a -> [a] -> [a]
forall a. Str a -> [a] -> [a]
g Str a
x [], (Str a, [a]) -> Str a
forall a b. (a, b) -> a
fst ((Str a, [a]) -> Str a) -> ([a] -> (Str a, [a])) -> [a] -> Str a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Str a -> [a] -> (Str a, [a])
forall a. Str a -> [a] -> (Str a, [a])
f Str a
x)
where
g :: Str a -> [a] -> [a]
g :: Str a -> [a] -> [a]
g Zero xs :: [a]
xs = [a]
xs
g (One x :: a
x) xs :: [a]
xs = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs
g (Two a :: Str a
a b :: Str a
b) xs :: [a]
xs = Str a -> [a] -> [a]
forall a. Str a -> [a] -> [a]
g Str a
a (Str a -> [a] -> [a]
forall a. Str a -> [a] -> [a]
g Str a
b [a]
xs)
f :: Str a -> [a] -> (Str a, [a])
f :: Str a -> [a] -> (Str a, [a])
f Zero rs :: [a]
rs = (Str a
forall a. Str a
Zero, [a]
rs)
f (One _) (r :: a
r:rs :: [a]
rs) = (a -> Str a
forall a. a -> Str a
One a
r, [a]
rs)
f (Two a :: Str a
a b :: Str a
b) rs1 :: [a]
rs1 = (Str a -> Str a -> Str a
forall a. Str a -> Str a -> Str a
Two Str a
a2 Str a
b2, [a]
rs3)
where
(a2 :: Str a
a2,rs2 :: [a]
rs2) = Str a -> [a] -> (Str a, [a])
forall a. Str a -> [a] -> (Str a, [a])
f Str a
a [a]
rs1
(b2 :: Str a
b2,rs3 :: [a]
rs3) = Str a -> [a] -> (Str a, [a])
forall a. Str a -> [a] -> (Str a, [a])
f Str a
b [a]
rs2