{-# 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

-- * The Data Type

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
    Str a
Zero == :: Str a -> Str a -> Bool
== Str a
Zero = Bool
True
    One a
x == One a
y = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
    Two Str a
x1 Str a
x2 == Two Str a
y1 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
    Str a
_ == Str a
_ = Bool
False


{-# INLINE strMap #-}
strMap :: (a -> b) -> Str a -> Str b
strMap :: (a -> b) -> Str a -> Str b
strMap a -> b
f 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 Str a
Zero = Str b
forall a. Str a
Zero
        g !t
spec (One 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 Str a
x 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 :: Applicative m => (a -> m b) -> Str a -> m (Str b)
strMapM :: (a -> m b) -> Str a -> m (Str b)
strMapM a -> m b
f 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 Str a
Zero = Str b -> m (Str b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Str b
forall a. Str a
Zero
        g !t
spec (One a
x) = b -> Str b
forall a. a -> Str a
One (b -> Str b) -> m b -> m (Str b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
f a
x
        g !t
spec (Two Str a
x Str a
y) = Str b -> Str b -> Str b
forall a. Str a -> Str a -> Str a
Two (Str b -> Str b -> Str b) -> m (Str b) -> m (Str b -> Str b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> Str a -> m (Str b)
g t
spec Str a
x m (Str b -> Str b) -> m (Str b) -> m (Str b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> t -> Str a -> m (Str b)
g t
spec Str a
y


instance Functor Str where
    fmap :: (a -> b) -> Str a -> Str b
fmap a -> b
f Str a
Zero = Str b
forall a. Str a
Zero
    fmap a -> b
f (One a
x) = b -> Str b
forall a. a -> Str a
One (a -> b
f a
x)
    fmap a -> b
f (Two Str a
x 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 a -> m
m Str a
Zero = m
forall a. Monoid a => a
mempty
    foldMap a -> m
m (One a
x) = a -> m
m a
x
    foldMap a -> m
m (Two Str a
l 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 a -> f b
f Str a
Zero = Str b -> f (Str b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Str b
forall a. Str a
Zero
    traverse a -> f b
f (One 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 a -> f b
f (Two Str a
x 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


-- | Take the type of the method, will crash if called
strType :: Str a -> a
strType :: Str a -> a
strType = String -> Str a -> a
forall a. HasCallStack => String -> a
error String
"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 :: Str a -> [a]
strList 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 t
x) Str t
xs) t -> t -> t
cons 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 Str t
Zero t -> t -> t
cons t
nil = t
nil


-- | Convert a list to a 'Str'
listStr :: [a] -> Str a
listStr :: [a] -> Str a
listStr (a
x:[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


-- | 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 :: Str a -> ([a], [a] -> Str a)
strStructure 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 Str a
Zero [a]
xs = [a]
xs
        g (One a
x) [a]
xs = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs
        g (Two Str a
a Str a
b) [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 Str a
Zero [a]
rs = (Str a
forall a. Str a
Zero, [a]
rs)
        f (One a
_) (a
r:[a]
rs) = (a -> Str a
forall a. a -> Str a
One a
r, [a]
rs)
        f (Two Str a
a Str a
b) [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
                (Str a
a2,[a]
rs2) = Str a -> [a] -> (Str a, [a])
forall a. Str a -> [a] -> (Str a, [a])
f Str a
a [a]
rs1
                (Str a
b2,[a]
rs3) = Str a -> [a] -> (Str a, [a])
forall a. Str a -> [a] -> (Str a, [a])
f Str a
b [a]
rs2