{-# LANGUAGE CPP #-}
#include "recursion-schemes-common.h"

#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable #-}
#if HAS_GENERIC
{-# LANGUAGE DeriveGeneric #-}
#endif
#endif

-- | Base Functors for standard types not already expressed as a fixed point.
module Data.Functor.Base
  ( ListF (..)
  , NonEmptyF(..)
  , TreeF (..), ForestF,
  ) where

#ifdef __GLASGOW_HASKELL__
import Data.Data (Typeable)
#if HAS_GENERIC
import GHC.Generics (Generic)
#endif
#if HAS_GENERIC1
import GHC.Generics (Generic1)
#endif
#endif

import Control.Applicative
import Data.Monoid

import Data.Functor.Classes
  ( Eq1(..), Ord1(..), Show1(..), Read1(..)
#ifdef LIFTED_FUNCTOR_CLASSES
  , Eq2(..), Ord2(..), Show2(..), Read2(..)
#endif
  )

import qualified Data.Foldable as F
import qualified Data.Traversable as T

import qualified Data.Bifunctor as Bi
import qualified Data.Bifoldable as Bi
import qualified Data.Bitraversable as Bi

import Prelude hiding (head, tail)

-------------------------------------------------------------------------------
-- ListF
-------------------------------------------------------------------------------

-- | Base functor of @[]@.
data ListF a b = Nil | Cons a b
  deriving (ListF a b -> ListF a b -> Bool
(ListF a b -> ListF a b -> Bool)
-> (ListF a b -> ListF a b -> Bool) -> Eq (ListF a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => ListF a b -> ListF a b -> Bool
/= :: ListF a b -> ListF a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => ListF a b -> ListF a b -> Bool
== :: ListF a b -> ListF a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => ListF a b -> ListF a b -> Bool
Eq,Eq (ListF a b)
Eq (ListF a b)
-> (ListF a b -> ListF a b -> Ordering)
-> (ListF a b -> ListF a b -> Bool)
-> (ListF a b -> ListF a b -> Bool)
-> (ListF a b -> ListF a b -> Bool)
-> (ListF a b -> ListF a b -> Bool)
-> (ListF a b -> ListF a b -> ListF a b)
-> (ListF a b -> ListF a b -> ListF a b)
-> Ord (ListF a b)
ListF a b -> ListF a b -> Bool
ListF a b -> ListF a b -> Ordering
ListF a b -> ListF a b -> ListF a b
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 a b. (Ord a, Ord b) => Eq (ListF a b)
forall a b. (Ord a, Ord b) => ListF a b -> ListF a b -> Bool
forall a b. (Ord a, Ord b) => ListF a b -> ListF a b -> Ordering
forall a b. (Ord a, Ord b) => ListF a b -> ListF a b -> ListF a b
min :: ListF a b -> ListF a b -> ListF a b
$cmin :: forall a b. (Ord a, Ord b) => ListF a b -> ListF a b -> ListF a b
max :: ListF a b -> ListF a b -> ListF a b
$cmax :: forall a b. (Ord a, Ord b) => ListF a b -> ListF a b -> ListF a b
>= :: ListF a b -> ListF a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => ListF a b -> ListF a b -> Bool
> :: ListF a b -> ListF a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => ListF a b -> ListF a b -> Bool
<= :: ListF a b -> ListF a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => ListF a b -> ListF a b -> Bool
< :: ListF a b -> ListF a b -> Bool
$c< :: forall a b. (Ord a, Ord b) => ListF a b -> ListF a b -> Bool
compare :: ListF a b -> ListF a b -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => ListF a b -> ListF a b -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (ListF a b)
Ord,Int -> ListF a b -> ShowS
[ListF a b] -> ShowS
ListF a b -> String
(Int -> ListF a b -> ShowS)
-> (ListF a b -> String)
-> ([ListF a b] -> ShowS)
-> Show (ListF a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> ListF a b -> ShowS
forall a b. (Show a, Show b) => [ListF a b] -> ShowS
forall a b. (Show a, Show b) => ListF a b -> String
showList :: [ListF a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [ListF a b] -> ShowS
show :: ListF a b -> String
$cshow :: forall a b. (Show a, Show b) => ListF a b -> String
showsPrec :: Int -> ListF a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> ListF a b -> ShowS
Show,ReadPrec [ListF a b]
ReadPrec (ListF a b)
Int -> ReadS (ListF a b)
ReadS [ListF a b]
(Int -> ReadS (ListF a b))
-> ReadS [ListF a b]
-> ReadPrec (ListF a b)
-> ReadPrec [ListF a b]
-> Read (ListF a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b. (Read a, Read b) => ReadPrec [ListF a b]
forall a b. (Read a, Read b) => ReadPrec (ListF a b)
forall a b. (Read a, Read b) => Int -> ReadS (ListF a b)
forall a b. (Read a, Read b) => ReadS [ListF a b]
readListPrec :: ReadPrec [ListF a b]
$creadListPrec :: forall a b. (Read a, Read b) => ReadPrec [ListF a b]
readPrec :: ReadPrec (ListF a b)
$creadPrec :: forall a b. (Read a, Read b) => ReadPrec (ListF a b)
readList :: ReadS [ListF a b]
$creadList :: forall a b. (Read a, Read b) => ReadS [ListF a b]
readsPrec :: Int -> ReadS (ListF a b)
$creadsPrec :: forall a b. (Read a, Read b) => Int -> ReadS (ListF a b)
Read,Typeable
#if HAS_GENERIC
          , (forall x. ListF a b -> Rep (ListF a b) x)
-> (forall x. Rep (ListF a b) x -> ListF a b)
-> Generic (ListF a b)
forall x. Rep (ListF a b) x -> ListF a b
forall x. ListF a b -> Rep (ListF a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (ListF a b) x -> ListF a b
forall a b x. ListF a b -> Rep (ListF a b) x
$cto :: forall a b x. Rep (ListF a b) x -> ListF a b
$cfrom :: forall a b x. ListF a b -> Rep (ListF a b) x
Generic
#endif
#if HAS_GENERIC1
          , (forall a. ListF a a -> Rep1 (ListF a) a)
-> (forall a. Rep1 (ListF a) a -> ListF a a) -> Generic1 (ListF a)
forall a. Rep1 (ListF a) a -> ListF a a
forall a. ListF a a -> Rep1 (ListF a) a
forall a a. Rep1 (ListF a) a -> ListF a a
forall a a. ListF a a -> Rep1 (ListF a) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a a. Rep1 (ListF a) a -> ListF a a
$cfrom1 :: forall a a. ListF a a -> Rep1 (ListF a) a
Generic1
#endif
          )

#ifdef LIFTED_FUNCTOR_CLASSES
instance Eq2 ListF where
  liftEq2 :: (a -> b -> Bool)
-> (c -> d -> Bool) -> ListF a c -> ListF b d -> Bool
liftEq2 a -> b -> Bool
_ c -> d -> Bool
_ ListF a c
Nil        ListF b d
Nil          = Bool
True
  liftEq2 a -> b -> Bool
f c -> d -> Bool
g (Cons a
a c
b) (Cons b
a' d
b') = a -> b -> Bool
f a
a b
a' Bool -> Bool -> Bool
&& c -> d -> Bool
g c
b d
b'
  liftEq2 a -> b -> Bool
_ c -> d -> Bool
_ ListF a c
_          ListF b d
_            = Bool
False

instance Eq a => Eq1 (ListF a) where
  liftEq :: (a -> b -> Bool) -> ListF a a -> ListF a b -> Bool
liftEq = (a -> a -> Bool)
-> (a -> b -> Bool) -> ListF a a -> ListF a b -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

instance Ord2 ListF where
  liftCompare2 :: (a -> b -> Ordering)
-> (c -> d -> Ordering) -> ListF a c -> ListF b d -> Ordering
liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
_ ListF a c
Nil        ListF b d
Nil          = Ordering
EQ
  liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
_ ListF a c
Nil        ListF b d
_            = Ordering
LT
  liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
_ ListF a c
_          ListF b d
Nil          = Ordering
GT
  liftCompare2 a -> b -> Ordering
f c -> d -> Ordering
g (Cons a
a c
b) (Cons b
a' d
b') = a -> b -> Ordering
f a
a b
a' Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` c -> d -> Ordering
g c
b d
b'

instance Ord a => Ord1 (ListF a) where
  liftCompare :: (a -> b -> Ordering) -> ListF a a -> ListF a b -> Ordering
liftCompare = (a -> a -> Ordering)
-> (a -> b -> Ordering) -> ListF a a -> ListF a b -> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

instance Show a => Show1 (ListF a) where
  liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> ListF a a -> ShowS
liftShowsPrec = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> ListF a a
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList

instance Show2 ListF where
  liftShowsPrec2 :: (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> ListF a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
_  [a] -> ShowS
_ Int -> b -> ShowS
_  [b] -> ShowS
_ Int
_ ListF a b
Nil        = String -> ShowS
showString String
"Nil"
  liftShowsPrec2 Int -> a -> ShowS
sa [a] -> ShowS
_ Int -> b -> ShowS
sb [b] -> ShowS
_ Int
d (Cons a
a b
b) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
    (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Cons "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
sa Int
11 a
a
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b -> ShowS
sb Int
11 b
b

instance Read2 ListF where
  liftReadsPrec2 :: (Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (ListF a b)
liftReadsPrec2 Int -> ReadS a
ra ReadS [a]
_ Int -> ReadS b
rb ReadS [b]
_ Int
d = Bool -> ReadS (ListF a b) -> ReadS (ListF a b)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (ListF a b) -> ReadS (ListF a b))
-> ReadS (ListF a b) -> ReadS (ListF a b)
forall a b. (a -> b) -> a -> b
$ \String
s -> ReadS (ListF a b)
forall a b. String -> [(ListF a b, String)]
nil String
s [(ListF a b, String)]
-> [(ListF a b, String)] -> [(ListF a b, String)]
forall a. [a] -> [a] -> [a]
++ ReadS (ListF a b)
cons String
s
    where
      nil :: String -> [(ListF a b, String)]
nil String
s0 = do
        (String
"Nil", String
s1) <- ReadS String
lex String
s0
        (ListF a b, String) -> [(ListF a b, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return (ListF a b
forall a b. ListF a b
Nil, String
s1)
      cons :: ReadS (ListF a b)
cons String
s0 = do
        (String
"Cons", String
s1) <- ReadS String
lex String
s0
        (a
a,      String
s2) <- Int -> ReadS a
ra Int
11 String
s1
        (b
b,      String
s3) <- Int -> ReadS b
rb Int
11 String
s2
        (ListF a b, String) -> [(ListF a b, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b -> ListF a b
forall a b. a -> b -> ListF a b
Cons a
a b
b, String
s3)

instance Read a => Read1 (ListF a) where
  liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (ListF a a)
liftReadsPrec = (Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS a)
-> ReadS [a]
-> Int
-> ReadS (ListF a a)
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec ReadS [a]
forall a. Read a => ReadS [a]
readList

#else
instance Eq a   => Eq1   (ListF a) where eq1        = (==)
instance Ord a  => Ord1  (ListF a) where compare1   = compare
instance Show a => Show1 (ListF a) where showsPrec1 = showsPrec
instance Read a => Read1 (ListF a) where readsPrec1 = readsPrec
#endif

-- These instances cannot be auto-derived on with GHC <= 7.6
instance Functor (ListF a) where
  fmap :: (a -> b) -> ListF a a -> ListF a b
fmap a -> b
_ ListF a a
Nil        = ListF a b
forall a b. ListF a b
Nil
  fmap a -> b
f (Cons a
a a
b) = a -> b -> ListF a b
forall a b. a -> b -> ListF a b
Cons a
a (a -> b
f a
b)

instance F.Foldable (ListF a) where
  foldMap :: (a -> m) -> ListF a a -> m
foldMap a -> m
_ ListF a a
Nil        = m
forall a. Monoid a => a
Data.Monoid.mempty
  foldMap a -> m
f (Cons a
_ a
b) = a -> m
f a
b

instance T.Traversable (ListF a) where
  traverse :: (a -> f b) -> ListF a a -> f (ListF a b)
traverse a -> f b
_ ListF a a
Nil        = ListF a b -> f (ListF a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListF a b
forall a b. ListF a b
Nil
  traverse a -> f b
f (Cons a
a a
b) = a -> b -> ListF a b
forall a b. a -> b -> ListF a b
Cons a
a (b -> ListF a b) -> f b -> f (ListF a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
b

instance Bi.Bifunctor ListF where
  bimap :: (a -> b) -> (c -> d) -> ListF a c -> ListF b d
bimap a -> b
_ c -> d
_ ListF a c
Nil        = ListF b d
forall a b. ListF a b
Nil
  bimap a -> b
f c -> d
g (Cons a
a c
b) = b -> d -> ListF b d
forall a b. a -> b -> ListF a b
Cons (a -> b
f a
a) (c -> d
g c
b)

instance Bi.Bifoldable ListF where
  bifoldMap :: (a -> m) -> (b -> m) -> ListF a b -> m
bifoldMap a -> m
_ b -> m
_ ListF a b
Nil        = m
forall a. Monoid a => a
mempty
  bifoldMap a -> m
f b -> m
g (Cons a
a b
b) = m -> m -> m
forall a. Monoid a => a -> a -> a
mappend (a -> m
f a
a) (b -> m
g b
b)

instance Bi.Bitraversable ListF where
  bitraverse :: (a -> f c) -> (b -> f d) -> ListF a b -> f (ListF c d)
bitraverse a -> f c
_ b -> f d
_ ListF a b
Nil        = ListF c d -> f (ListF c d)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListF c d
forall a b. ListF a b
Nil
  bitraverse a -> f c
f b -> f d
g (Cons a
a b
b) = c -> d -> ListF c d
forall a b. a -> b -> ListF a b
Cons (c -> d -> ListF c d) -> f c -> f (d -> ListF c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a f (d -> ListF c d) -> f d -> f (ListF c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> f d
g b
b

-------------------------------------------------------------------------------
-- NonEmpty
-------------------------------------------------------------------------------

-- | Base Functor for 'Data.List.NonEmpty'
data NonEmptyF a b = NonEmptyF { NonEmptyF a b -> a
head :: a, NonEmptyF a b -> Maybe b
tail :: Maybe b }
  deriving (NonEmptyF a b -> NonEmptyF a b -> Bool
(NonEmptyF a b -> NonEmptyF a b -> Bool)
-> (NonEmptyF a b -> NonEmptyF a b -> Bool) -> Eq (NonEmptyF a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => NonEmptyF a b -> NonEmptyF a b -> Bool
/= :: NonEmptyF a b -> NonEmptyF a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => NonEmptyF a b -> NonEmptyF a b -> Bool
== :: NonEmptyF a b -> NonEmptyF a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => NonEmptyF a b -> NonEmptyF a b -> Bool
Eq,Eq (NonEmptyF a b)
Eq (NonEmptyF a b)
-> (NonEmptyF a b -> NonEmptyF a b -> Ordering)
-> (NonEmptyF a b -> NonEmptyF a b -> Bool)
-> (NonEmptyF a b -> NonEmptyF a b -> Bool)
-> (NonEmptyF a b -> NonEmptyF a b -> Bool)
-> (NonEmptyF a b -> NonEmptyF a b -> Bool)
-> (NonEmptyF a b -> NonEmptyF a b -> NonEmptyF a b)
-> (NonEmptyF a b -> NonEmptyF a b -> NonEmptyF a b)
-> Ord (NonEmptyF a b)
NonEmptyF a b -> NonEmptyF a b -> Bool
NonEmptyF a b -> NonEmptyF a b -> Ordering
NonEmptyF a b -> NonEmptyF a b -> NonEmptyF a b
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 a b. (Ord a, Ord b) => Eq (NonEmptyF a b)
forall a b.
(Ord a, Ord b) =>
NonEmptyF a b -> NonEmptyF a b -> Bool
forall a b.
(Ord a, Ord b) =>
NonEmptyF a b -> NonEmptyF a b -> Ordering
forall a b.
(Ord a, Ord b) =>
NonEmptyF a b -> NonEmptyF a b -> NonEmptyF a b
min :: NonEmptyF a b -> NonEmptyF a b -> NonEmptyF a b
$cmin :: forall a b.
(Ord a, Ord b) =>
NonEmptyF a b -> NonEmptyF a b -> NonEmptyF a b
max :: NonEmptyF a b -> NonEmptyF a b -> NonEmptyF a b
$cmax :: forall a b.
(Ord a, Ord b) =>
NonEmptyF a b -> NonEmptyF a b -> NonEmptyF a b
>= :: NonEmptyF a b -> NonEmptyF a b -> Bool
$c>= :: forall a b.
(Ord a, Ord b) =>
NonEmptyF a b -> NonEmptyF a b -> Bool
> :: NonEmptyF a b -> NonEmptyF a b -> Bool
$c> :: forall a b.
(Ord a, Ord b) =>
NonEmptyF a b -> NonEmptyF a b -> Bool
<= :: NonEmptyF a b -> NonEmptyF a b -> Bool
$c<= :: forall a b.
(Ord a, Ord b) =>
NonEmptyF a b -> NonEmptyF a b -> Bool
< :: NonEmptyF a b -> NonEmptyF a b -> Bool
$c< :: forall a b.
(Ord a, Ord b) =>
NonEmptyF a b -> NonEmptyF a b -> Bool
compare :: NonEmptyF a b -> NonEmptyF a b -> Ordering
$ccompare :: forall a b.
(Ord a, Ord b) =>
NonEmptyF a b -> NonEmptyF a b -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (NonEmptyF a b)
Ord,Int -> NonEmptyF a b -> ShowS
[NonEmptyF a b] -> ShowS
NonEmptyF a b -> String
(Int -> NonEmptyF a b -> ShowS)
-> (NonEmptyF a b -> String)
-> ([NonEmptyF a b] -> ShowS)
-> Show (NonEmptyF a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> NonEmptyF a b -> ShowS
forall a b. (Show a, Show b) => [NonEmptyF a b] -> ShowS
forall a b. (Show a, Show b) => NonEmptyF a b -> String
showList :: [NonEmptyF a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [NonEmptyF a b] -> ShowS
show :: NonEmptyF a b -> String
$cshow :: forall a b. (Show a, Show b) => NonEmptyF a b -> String
showsPrec :: Int -> NonEmptyF a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> NonEmptyF a b -> ShowS
Show,ReadPrec [NonEmptyF a b]
ReadPrec (NonEmptyF a b)
Int -> ReadS (NonEmptyF a b)
ReadS [NonEmptyF a b]
(Int -> ReadS (NonEmptyF a b))
-> ReadS [NonEmptyF a b]
-> ReadPrec (NonEmptyF a b)
-> ReadPrec [NonEmptyF a b]
-> Read (NonEmptyF a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b. (Read a, Read b) => ReadPrec [NonEmptyF a b]
forall a b. (Read a, Read b) => ReadPrec (NonEmptyF a b)
forall a b. (Read a, Read b) => Int -> ReadS (NonEmptyF a b)
forall a b. (Read a, Read b) => ReadS [NonEmptyF a b]
readListPrec :: ReadPrec [NonEmptyF a b]
$creadListPrec :: forall a b. (Read a, Read b) => ReadPrec [NonEmptyF a b]
readPrec :: ReadPrec (NonEmptyF a b)
$creadPrec :: forall a b. (Read a, Read b) => ReadPrec (NonEmptyF a b)
readList :: ReadS [NonEmptyF a b]
$creadList :: forall a b. (Read a, Read b) => ReadS [NonEmptyF a b]
readsPrec :: Int -> ReadS (NonEmptyF a b)
$creadsPrec :: forall a b. (Read a, Read b) => Int -> ReadS (NonEmptyF a b)
Read,Typeable
#if HAS_GENERIC
          , (forall x. NonEmptyF a b -> Rep (NonEmptyF a b) x)
-> (forall x. Rep (NonEmptyF a b) x -> NonEmptyF a b)
-> Generic (NonEmptyF a b)
forall x. Rep (NonEmptyF a b) x -> NonEmptyF a b
forall x. NonEmptyF a b -> Rep (NonEmptyF a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (NonEmptyF a b) x -> NonEmptyF a b
forall a b x. NonEmptyF a b -> Rep (NonEmptyF a b) x
$cto :: forall a b x. Rep (NonEmptyF a b) x -> NonEmptyF a b
$cfrom :: forall a b x. NonEmptyF a b -> Rep (NonEmptyF a b) x
Generic
#endif
#if HAS_GENERIC1
          , (forall a. NonEmptyF a a -> Rep1 (NonEmptyF a) a)
-> (forall a. Rep1 (NonEmptyF a) a -> NonEmptyF a a)
-> Generic1 (NonEmptyF a)
forall a. Rep1 (NonEmptyF a) a -> NonEmptyF a a
forall a. NonEmptyF a a -> Rep1 (NonEmptyF a) a
forall a a. Rep1 (NonEmptyF a) a -> NonEmptyF a a
forall a a. NonEmptyF a a -> Rep1 (NonEmptyF a) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a a. Rep1 (NonEmptyF a) a -> NonEmptyF a a
$cfrom1 :: forall a a. NonEmptyF a a -> Rep1 (NonEmptyF a) a
Generic1
#endif
          )

#ifdef LIFTED_FUNCTOR_CLASSES
instance Eq2 NonEmptyF where
  liftEq2 :: (a -> b -> Bool)
-> (c -> d -> Bool) -> NonEmptyF a c -> NonEmptyF b d -> Bool
liftEq2 a -> b -> Bool
f c -> d -> Bool
g (NonEmptyF a
a Maybe c
mb) (NonEmptyF b
a' Maybe d
mb') = a -> b -> Bool
f a
a b
a' Bool -> Bool -> Bool
&& (c -> d -> Bool) -> Maybe c -> Maybe d -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq c -> d -> Bool
g Maybe c
mb Maybe d
mb'

instance Eq a => Eq1 (NonEmptyF a) where
  liftEq :: (a -> b -> Bool) -> NonEmptyF a a -> NonEmptyF a b -> Bool
liftEq = (a -> a -> Bool)
-> (a -> b -> Bool) -> NonEmptyF a a -> NonEmptyF a b -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

instance Ord2 NonEmptyF where
  liftCompare2 :: (a -> b -> Ordering)
-> (c -> d -> Ordering)
-> NonEmptyF a c
-> NonEmptyF b d
-> Ordering
liftCompare2 a -> b -> Ordering
f c -> d -> Ordering
g (NonEmptyF a
a Maybe c
mb) (NonEmptyF b
a' Maybe d
mb') = a -> b -> Ordering
f a
a b
a' Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` (c -> d -> Ordering) -> Maybe c -> Maybe d -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare c -> d -> Ordering
g Maybe c
mb Maybe d
mb'

instance Ord a => Ord1 (NonEmptyF a) where
  liftCompare :: (a -> b -> Ordering) -> NonEmptyF a a -> NonEmptyF a b -> Ordering
liftCompare = (a -> a -> Ordering)
-> (a -> b -> Ordering)
-> NonEmptyF a a
-> NonEmptyF a b
-> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

instance Show a => Show1 (NonEmptyF a) where
  liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> NonEmptyF a a -> ShowS
liftShowsPrec = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> NonEmptyF a a
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList

instance Show2 NonEmptyF where
  liftShowsPrec2 :: (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> NonEmptyF a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sa [a] -> ShowS
_ Int -> b -> ShowS
sb [b] -> ShowS
slb Int
d (NonEmptyF a
a Maybe b
b) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
    (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"NonEmptyF "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
sa Int
11 a
a
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> Maybe b -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> b -> ShowS
sb [b] -> ShowS
slb Int
11 Maybe b
b

instance Read2 NonEmptyF where
  liftReadsPrec2 :: (Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (NonEmptyF a b)
liftReadsPrec2 Int -> ReadS a
ra ReadS [a]
_ Int -> ReadS b
rb ReadS [b]
rlb Int
d = Bool -> ReadS (NonEmptyF a b) -> ReadS (NonEmptyF a b)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (NonEmptyF a b) -> ReadS (NonEmptyF a b))
-> ReadS (NonEmptyF a b) -> ReadS (NonEmptyF a b)
forall a b. (a -> b) -> a -> b
$ \String
s -> ReadS (NonEmptyF a b)
cons String
s
    where
      cons :: ReadS (NonEmptyF a b)
cons String
s0 = do
        (String
"NonEmptyF", String
s1) <- ReadS String
lex String
s0
        (a
a,      String
s2) <- Int -> ReadS a
ra Int
11 String
s1
        (Maybe b
mb,     String
s3) <- (Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (Maybe b)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS b
rb ReadS [b]
rlb Int
11 String
s2
        (NonEmptyF a b, String) -> [(NonEmptyF a b, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe b -> NonEmptyF a b
forall a b. a -> Maybe b -> NonEmptyF a b
NonEmptyF a
a Maybe b
mb, String
s3)

instance Read a => Read1 (NonEmptyF a) where
  liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (NonEmptyF a a)
liftReadsPrec = (Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS a)
-> ReadS [a]
-> Int
-> ReadS (NonEmptyF a a)
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec ReadS [a]
forall a. Read a => ReadS [a]
readList

#else
instance Eq a   => Eq1   (NonEmptyF a) where eq1        = (==)
instance Ord a  => Ord1  (NonEmptyF a) where compare1   = compare
instance Show a => Show1 (NonEmptyF a) where showsPrec1 = showsPrec
instance Read a => Read1 (NonEmptyF a) where readsPrec1 = readsPrec
#endif

-- These instances cannot be auto-derived on with GHC <= 7.6
instance Functor (NonEmptyF a) where
  fmap :: (a -> b) -> NonEmptyF a a -> NonEmptyF a b
fmap a -> b
f = a -> Maybe b -> NonEmptyF a b
forall a b. a -> Maybe b -> NonEmptyF a b
NonEmptyF (a -> Maybe b -> NonEmptyF a b)
-> (NonEmptyF a a -> a)
-> NonEmptyF a a
-> Maybe b
-> NonEmptyF a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmptyF a a -> a
forall a b. NonEmptyF a b -> a
head (NonEmptyF a a -> Maybe b -> NonEmptyF a b)
-> (NonEmptyF a a -> Maybe b) -> NonEmptyF a a -> NonEmptyF a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Maybe a -> Maybe b)
-> (NonEmptyF a a -> Maybe a) -> NonEmptyF a a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyF a a -> Maybe a
forall a b. NonEmptyF a b -> Maybe b
tail)

instance F.Foldable (NonEmptyF a) where
  foldMap :: (a -> m) -> NonEmptyF a a -> m
foldMap a -> m
f = (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap a -> m
f (Maybe a -> m) -> (NonEmptyF a a -> Maybe a) -> NonEmptyF a a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyF a a -> Maybe a
forall a b. NonEmptyF a b -> Maybe b
tail

instance T.Traversable (NonEmptyF a) where
  traverse :: (a -> f b) -> NonEmptyF a a -> f (NonEmptyF a b)
traverse a -> f b
f = (Maybe b -> NonEmptyF a b) -> f (Maybe b) -> f (NonEmptyF a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe b -> NonEmptyF a b) -> f (Maybe b) -> f (NonEmptyF a b))
-> (NonEmptyF a a -> Maybe b -> NonEmptyF a b)
-> NonEmptyF a a
-> f (Maybe b)
-> f (NonEmptyF a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Maybe b -> NonEmptyF a b
forall a b. a -> Maybe b -> NonEmptyF a b
NonEmptyF (a -> Maybe b -> NonEmptyF a b)
-> (NonEmptyF a a -> a)
-> NonEmptyF a a
-> Maybe b
-> NonEmptyF a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyF a a -> a
forall a b. NonEmptyF a b -> a
head) (NonEmptyF a a -> f (Maybe b) -> f (NonEmptyF a b))
-> (NonEmptyF a a -> f (Maybe b))
-> NonEmptyF a a
-> f (NonEmptyF a b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a -> f b) -> Maybe a -> f (Maybe b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse a -> f b
f (Maybe a -> f (Maybe b))
-> (NonEmptyF a a -> Maybe a) -> NonEmptyF a a -> f (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyF a a -> Maybe a
forall a b. NonEmptyF a b -> Maybe b
tail)

instance Bi.Bifunctor NonEmptyF where
  bimap :: (a -> b) -> (c -> d) -> NonEmptyF a c -> NonEmptyF b d
bimap a -> b
f c -> d
g = b -> Maybe d -> NonEmptyF b d
forall a b. a -> Maybe b -> NonEmptyF a b
NonEmptyF (b -> Maybe d -> NonEmptyF b d)
-> (NonEmptyF a c -> b)
-> NonEmptyF a c
-> Maybe d
-> NonEmptyF b d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> b
f (a -> b) -> (NonEmptyF a c -> a) -> NonEmptyF a c -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyF a c -> a
forall a b. NonEmptyF a b -> a
head) (NonEmptyF a c -> Maybe d -> NonEmptyF b d)
-> (NonEmptyF a c -> Maybe d) -> NonEmptyF a c -> NonEmptyF b d
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((c -> d) -> Maybe c -> Maybe d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g (Maybe c -> Maybe d)
-> (NonEmptyF a c -> Maybe c) -> NonEmptyF a c -> Maybe d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyF a c -> Maybe c
forall a b. NonEmptyF a b -> Maybe b
tail)

instance Bi.Bifoldable NonEmptyF where
  bifoldMap :: (a -> m) -> (b -> m) -> NonEmptyF a b -> m
bifoldMap a -> m
f b -> m
g = m -> Maybe m -> m
forall a. Monoid a => a -> Maybe a -> a
merge (m -> Maybe m -> m)
-> (NonEmptyF a b -> m) -> NonEmptyF a b -> Maybe m -> m
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m
f (a -> m) -> (NonEmptyF a b -> a) -> NonEmptyF a b -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyF a b -> a
forall a b. NonEmptyF a b -> a
head) (NonEmptyF a b -> Maybe m -> m)
-> (NonEmptyF a b -> Maybe m) -> NonEmptyF a b -> m
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((b -> m) -> Maybe b -> Maybe m
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> m
g (Maybe b -> Maybe m)
-> (NonEmptyF a b -> Maybe b) -> NonEmptyF a b -> Maybe m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyF a b -> Maybe b
forall a b. NonEmptyF a b -> Maybe b
tail)
    where merge :: a -> Maybe a -> a
merge a
x Maybe a
my = a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
x (a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
x) Maybe a
my

instance Bi.Bitraversable NonEmptyF where
  bitraverse :: (a -> f c) -> (b -> f d) -> NonEmptyF a b -> f (NonEmptyF c d)
bitraverse a -> f c
f b -> f d
g = (c -> Maybe d -> NonEmptyF c d)
-> f c -> f (Maybe d) -> f (NonEmptyF c d)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 c -> Maybe d -> NonEmptyF c d
forall a b. a -> Maybe b -> NonEmptyF a b
NonEmptyF (f c -> f (Maybe d) -> f (NonEmptyF c d))
-> (NonEmptyF a b -> f c)
-> NonEmptyF a b
-> f (Maybe d)
-> f (NonEmptyF c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f c
f (a -> f c) -> (NonEmptyF a b -> a) -> NonEmptyF a b -> f c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyF a b -> a
forall a b. NonEmptyF a b -> a
head) (NonEmptyF a b -> f (Maybe d) -> f (NonEmptyF c d))
-> (NonEmptyF a b -> f (Maybe d))
-> NonEmptyF a b
-> f (NonEmptyF c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((b -> f d) -> Maybe b -> f (Maybe d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse b -> f d
g (Maybe b -> f (Maybe d))
-> (NonEmptyF a b -> Maybe b) -> NonEmptyF a b -> f (Maybe d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyF a b -> Maybe b
forall a b. NonEmptyF a b -> Maybe b
tail)

-------------------------------------------------------------------------------
-- Tree
-------------------------------------------------------------------------------

-- | Base functor for 'Data.Tree.Tree'.
data TreeF a b = NodeF a (ForestF a b)
  deriving (TreeF a b -> TreeF a b -> Bool
(TreeF a b -> TreeF a b -> Bool)
-> (TreeF a b -> TreeF a b -> Bool) -> Eq (TreeF a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => TreeF a b -> TreeF a b -> Bool
/= :: TreeF a b -> TreeF a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => TreeF a b -> TreeF a b -> Bool
== :: TreeF a b -> TreeF a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => TreeF a b -> TreeF a b -> Bool
Eq,Eq (TreeF a b)
Eq (TreeF a b)
-> (TreeF a b -> TreeF a b -> Ordering)
-> (TreeF a b -> TreeF a b -> Bool)
-> (TreeF a b -> TreeF a b -> Bool)
-> (TreeF a b -> TreeF a b -> Bool)
-> (TreeF a b -> TreeF a b -> Bool)
-> (TreeF a b -> TreeF a b -> TreeF a b)
-> (TreeF a b -> TreeF a b -> TreeF a b)
-> Ord (TreeF a b)
TreeF a b -> TreeF a b -> Bool
TreeF a b -> TreeF a b -> Ordering
TreeF a b -> TreeF a b -> TreeF a b
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 a b. (Ord a, Ord b) => Eq (TreeF a b)
forall a b. (Ord a, Ord b) => TreeF a b -> TreeF a b -> Bool
forall a b. (Ord a, Ord b) => TreeF a b -> TreeF a b -> Ordering
forall a b. (Ord a, Ord b) => TreeF a b -> TreeF a b -> TreeF a b
min :: TreeF a b -> TreeF a b -> TreeF a b
$cmin :: forall a b. (Ord a, Ord b) => TreeF a b -> TreeF a b -> TreeF a b
max :: TreeF a b -> TreeF a b -> TreeF a b
$cmax :: forall a b. (Ord a, Ord b) => TreeF a b -> TreeF a b -> TreeF a b
>= :: TreeF a b -> TreeF a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => TreeF a b -> TreeF a b -> Bool
> :: TreeF a b -> TreeF a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => TreeF a b -> TreeF a b -> Bool
<= :: TreeF a b -> TreeF a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => TreeF a b -> TreeF a b -> Bool
< :: TreeF a b -> TreeF a b -> Bool
$c< :: forall a b. (Ord a, Ord b) => TreeF a b -> TreeF a b -> Bool
compare :: TreeF a b -> TreeF a b -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => TreeF a b -> TreeF a b -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (TreeF a b)
Ord,Int -> TreeF a b -> ShowS
[TreeF a b] -> ShowS
TreeF a b -> String
(Int -> TreeF a b -> ShowS)
-> (TreeF a b -> String)
-> ([TreeF a b] -> ShowS)
-> Show (TreeF a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> TreeF a b -> ShowS
forall a b. (Show a, Show b) => [TreeF a b] -> ShowS
forall a b. (Show a, Show b) => TreeF a b -> String
showList :: [TreeF a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [TreeF a b] -> ShowS
show :: TreeF a b -> String
$cshow :: forall a b. (Show a, Show b) => TreeF a b -> String
showsPrec :: Int -> TreeF a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> TreeF a b -> ShowS
Show,ReadPrec [TreeF a b]
ReadPrec (TreeF a b)
Int -> ReadS (TreeF a b)
ReadS [TreeF a b]
(Int -> ReadS (TreeF a b))
-> ReadS [TreeF a b]
-> ReadPrec (TreeF a b)
-> ReadPrec [TreeF a b]
-> Read (TreeF a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b. (Read a, Read b) => ReadPrec [TreeF a b]
forall a b. (Read a, Read b) => ReadPrec (TreeF a b)
forall a b. (Read a, Read b) => Int -> ReadS (TreeF a b)
forall a b. (Read a, Read b) => ReadS [TreeF a b]
readListPrec :: ReadPrec [TreeF a b]
$creadListPrec :: forall a b. (Read a, Read b) => ReadPrec [TreeF a b]
readPrec :: ReadPrec (TreeF a b)
$creadPrec :: forall a b. (Read a, Read b) => ReadPrec (TreeF a b)
readList :: ReadS [TreeF a b]
$creadList :: forall a b. (Read a, Read b) => ReadS [TreeF a b]
readsPrec :: Int -> ReadS (TreeF a b)
$creadsPrec :: forall a b. (Read a, Read b) => Int -> ReadS (TreeF a b)
Read,Typeable
#if HAS_GENERIC
          , (forall x. TreeF a b -> Rep (TreeF a b) x)
-> (forall x. Rep (TreeF a b) x -> TreeF a b)
-> Generic (TreeF a b)
forall x. Rep (TreeF a b) x -> TreeF a b
forall x. TreeF a b -> Rep (TreeF a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (TreeF a b) x -> TreeF a b
forall a b x. TreeF a b -> Rep (TreeF a b) x
$cto :: forall a b x. Rep (TreeF a b) x -> TreeF a b
$cfrom :: forall a b x. TreeF a b -> Rep (TreeF a b) x
Generic
#endif
#if HAS_GENERIC1
          , (forall a. TreeF a a -> Rep1 (TreeF a) a)
-> (forall a. Rep1 (TreeF a) a -> TreeF a a) -> Generic1 (TreeF a)
forall a. Rep1 (TreeF a) a -> TreeF a a
forall a. TreeF a a -> Rep1 (TreeF a) a
forall a a. Rep1 (TreeF a) a -> TreeF a a
forall a a. TreeF a a -> Rep1 (TreeF a) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a a. Rep1 (TreeF a) a -> TreeF a a
$cfrom1 :: forall a a. TreeF a a -> Rep1 (TreeF a) a
Generic1
#endif
          )

type ForestF a b = [b]

#ifdef LIFTED_FUNCTOR_CLASSES
instance Eq2 TreeF where
  liftEq2 :: (a -> b -> Bool)
-> (c -> d -> Bool) -> TreeF a c -> TreeF b d -> Bool
liftEq2 a -> b -> Bool
f c -> d -> Bool
g (NodeF a
a ForestF a c
mb) (NodeF b
a' ForestF b d
mb') = a -> b -> Bool
f a
a b
a' Bool -> Bool -> Bool
&& (c -> d -> Bool) -> ForestF a c -> ForestF b d -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq c -> d -> Bool
g ForestF a c
mb ForestF b d
mb'

instance Eq a => Eq1 (TreeF a) where
  liftEq :: (a -> b -> Bool) -> TreeF a a -> TreeF a b -> Bool
liftEq = (a -> a -> Bool)
-> (a -> b -> Bool) -> TreeF a a -> TreeF a b -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

instance Ord2 TreeF where
  liftCompare2 :: (a -> b -> Ordering)
-> (c -> d -> Ordering) -> TreeF a c -> TreeF b d -> Ordering
liftCompare2 a -> b -> Ordering
f c -> d -> Ordering
g (NodeF a
a ForestF a c
mb) (NodeF b
a' ForestF b d
mb') = a -> b -> Ordering
f a
a b
a' Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` (c -> d -> Ordering) -> ForestF a c -> ForestF b d -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare c -> d -> Ordering
g ForestF a c
mb ForestF b d
mb'

instance Ord a => Ord1 (TreeF a) where
  liftCompare :: (a -> b -> Ordering) -> TreeF a a -> TreeF a b -> Ordering
liftCompare = (a -> a -> Ordering)
-> (a -> b -> Ordering) -> TreeF a a -> TreeF a b -> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

instance Show a => Show1 (TreeF a) where
  liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> TreeF a a -> ShowS
liftShowsPrec = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> TreeF a a
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList

instance Show2 TreeF where
  liftShowsPrec2 :: (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> TreeF a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sa [a] -> ShowS
_ Int -> b -> ShowS
sb [b] -> ShowS
slb Int
d (NodeF a
a [b]
b) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
    (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"NodeF "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
sa Int
11 a
a
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> [b] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> b -> ShowS
sb [b] -> ShowS
slb Int
11 [b]
b

instance Read2 TreeF where
  liftReadsPrec2 :: (Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (TreeF a b)
liftReadsPrec2 Int -> ReadS a
ra ReadS [a]
_ Int -> ReadS b
rb ReadS [b]
rlb Int
d = Bool -> ReadS (TreeF a b) -> ReadS (TreeF a b)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (TreeF a b) -> ReadS (TreeF a b))
-> ReadS (TreeF a b) -> ReadS (TreeF a b)
forall a b. (a -> b) -> a -> b
$ \String
s -> ReadS (TreeF a b)
cons String
s
    where
      cons :: ReadS (TreeF a b)
cons String
s0 = do
        (String
"NodeF", String
s1) <- ReadS String
lex String
s0
        (a
a,      String
s2) <- Int -> ReadS a
ra Int
11 String
s1
        ([b]
mb,     String
s3) <- (Int -> ReadS b) -> ReadS [b] -> Int -> ReadS [b]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS b
rb ReadS [b]
rlb Int
11 String
s2
        (TreeF a b, String) -> [(TreeF a b, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> [b] -> TreeF a b
forall a b. a -> ForestF a b -> TreeF a b
NodeF a
a [b]
mb, String
s3)

instance Read a => Read1 (TreeF a) where
  liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (TreeF a a)
liftReadsPrec = (Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS a)
-> ReadS [a]
-> Int
-> ReadS (TreeF a a)
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec ReadS [a]
forall a. Read a => ReadS [a]
readList

#else
instance Eq a   => Eq1   (TreeF a) where eq1        = (==)
instance Ord a  => Ord1  (TreeF a) where compare1   = compare
instance Show a => Show1 (TreeF a) where showsPrec1 = showsPrec
instance Read a => Read1 (TreeF a) where readsPrec1 = readsPrec
#endif

-- These instances cannot be auto-derived on with GHC <= 7.6
instance Functor (TreeF a) where
  fmap :: (a -> b) -> TreeF a a -> TreeF a b
fmap a -> b
f (NodeF a
x ForestF a a
xs) = a -> ForestF a b -> TreeF a b
forall a b. a -> ForestF a b -> TreeF a b
NodeF a
x ((a -> b) -> ForestF a a -> ForestF a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ForestF a a
xs)

instance F.Foldable (TreeF a) where
  foldMap :: (a -> m) -> TreeF a a -> m
foldMap a -> m
f (NodeF a
_ ForestF a a
xs) = (a -> m) -> ForestF a a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap a -> m
f ForestF a a
xs

instance T.Traversable (TreeF a) where
  traverse :: (a -> f b) -> TreeF a a -> f (TreeF a b)
traverse a -> f b
f (NodeF a
x ForestF a a
xs) = a -> ForestF a b -> TreeF a b
forall a b. a -> ForestF a b -> TreeF a b
NodeF a
x (ForestF a b -> TreeF a b) -> f (ForestF a b) -> f (TreeF a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> ForestF a a -> f (ForestF a b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse a -> f b
f ForestF a a
xs

instance Bi.Bifunctor TreeF where
  bimap :: (a -> b) -> (c -> d) -> TreeF a c -> TreeF b d
bimap a -> b
f c -> d
g (NodeF a
x ForestF a c
xs) = b -> ForestF b d -> TreeF b d
forall a b. a -> ForestF a b -> TreeF a b
NodeF (a -> b
f a
x) ((c -> d) -> ForestF a c -> ForestF b d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g ForestF a c
xs)

instance Bi.Bifoldable TreeF where
  bifoldMap :: (a -> m) -> (b -> m) -> TreeF a b -> m
bifoldMap a -> m
f b -> m
g (NodeF a
x ForestF a b
xs) = a -> m
f a
x m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (b -> m) -> ForestF a b -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap b -> m
g ForestF a b
xs

instance Bi.Bitraversable TreeF where
  bitraverse :: (a -> f c) -> (b -> f d) -> TreeF a b -> f (TreeF c d)
bitraverse a -> f c
f b -> f d
g (NodeF a
x ForestF a b
xs) = (c -> ForestF c d -> TreeF c d)
-> f c -> f (ForestF c d) -> f (TreeF c d)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 c -> ForestF c d -> TreeF c d
forall a b. a -> ForestF a b -> TreeF a b
NodeF (a -> f c
f a
x) ((b -> f d) -> ForestF a b -> f (ForestF c d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse b -> f d
g ForestF a b
xs)